C4/Biblio.pm

   1 package C4::Biblio;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 use warnings;
  22 # use utf8;
  23 use MARC::Record;
  24 use MARC::File::USMARC;
  25 use MARC::File::XML;
  26 use ZOOM;
  27 use POSIX qw(strftime);
  28
  29 use C4::Koha;
  30 use C4::Dates qw/format_date/;
  31 use C4::Log; # logaction
  32 use C4::ClassSource;
  33 use C4::Charset;
  34 require C4::Heading;
  35 require C4::Serials;
  36
  37 use vars qw($VERSION @ISA @EXPORT);
  38
  39 BEGIN {
  40         $VERSION = 1.00;
  41
  42         require Exporter;
  43         @ISA = qw( Exporter );
  44
  45         # to add biblios
  46 # EXPORTED FUNCTIONS.
  47         push @EXPORT, qw(
  48                 &AddBiblio
  49         );
  50
  51         # to get something
  52         push @EXPORT, qw(
  53                 &GetBiblio
  54                 &GetBiblioData
  55                 &GetBiblioItemData
  56                 &GetBiblioItemInfosOf
  57                 &GetBiblioItemByBiblioNumber
  58                 &GetBiblioFromItemNumber
  59
  60                 &GetISBDView
  61
  62                 &GetMarcNotes
  63                 &GetMarcSubjects
  64                 &GetMarcBiblio
  65                 &GetMarcAuthors
  66                 &GetMarcSeries
  67                 GetMarcUrls
  68                 &GetUsedMarcStructure
  69                 &GetXmlBiblio
  70         &GetCOinSBiblio
  71
  72                 &GetAuthorisedValueDesc
  73                 &GetMarcStructure
  74                 &GetMarcFromKohaField
  75                 &GetFrameworkCode
  76                 &GetPublisherNameFromIsbn
  77                 &TransformKohaToMarc
  78         );
  79
  80         # To modify something
  81         push @EXPORT, qw(
  82                 &ModBiblio
  83                 &ModBiblioframework
  84                 &ModZebra
  85         );
  86         # To delete something
  87         push @EXPORT, qw(
  88                 &DelBiblio
  89         );
  90
  91     # To link headings in a bib record
  92     # to authority records.
  93     push @EXPORT, qw(
  94         &LinkBibHeadingsToAuthorities
  95     );
  96
  97         # Internal functions
  98         # those functions are exported but should not be used
  99         # they are usefull is few circumstances, so are exported.
 100         # but don't use them unless you're a core developer ;-)
 101         push @EXPORT, qw(
 102                 &ModBiblioMarc
 103         );
 104         # Others functions
 105         push @EXPORT, qw(
 106                 &TransformMarcToKoha
 107                 &TransformHtmlToMarc2
 108                 &TransformHtmlToMarc
 109                 &TransformHtmlToXml
 110                 &PrepareItemrecordDisplay
 111                 &GetNoZebraIndexes
 112         );
 113 }
 114
 115 =head1 NAME
 116
 117 C4::Biblio - cataloging management functions
 118
 119 =head1 DESCRIPTION
 120
 121 Biblio.pm contains functions for managing storage and editing of bibliographic data within Koha. Most of the functions in this module are used for cataloging records: adding, editing, or removing biblios, biblioitems, or items. Koha's stores bibliographic information in three places:
 122
 123 =over 4
 124
 125 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
 126
 127 =item 2. as raw MARC in the Zebra index and storage engine
 128
 129 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
 130
 131 =back
 132
 133 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
 134
 135 Because the data isn't completely normalized there's a chance for information to get out of sync. The design choice to go with a un-normalized schema was driven by performance and stability concerns. However, if this occur, it can be considered as a bug : The API is (or should be) complete & the only entry point for all biblio/items managements.
 136
 137 =over 4
 138
 139 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
 140
 141 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
 142
 143 =back
 144
 145 Because of this design choice, the process of managing storage and editing is a bit convoluted. Historically, Biblio.pm's grown to an unmanagable size and as a result we have several types of functions currently:
 146
 147 =over 4
 148
 149 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
 150
 151 =item 2. _koha_* - low-level internal functions for managing the koha tables
 152
 153 =item 3. Marc management function : as the MARC record is stored in biblioitems.marc(xml), some subs dedicated to it's management are in this package. They should be used only internally by Biblio.pm, the only official entry points being AddBiblio, AddItem, ModBiblio, ModItem.
 154
 155 =item 4. Zebra functions used to update the Zebra index
 156
 157 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
 158
 159 =back
 160
 161 The MARC record (in biblioitems.marcxml) contains the complete marc record, including items. It also contains the biblionumber. That is the reason why it is not stored directly by AddBiblio, with all other fields . To save a biblio, we need to :
 162
 163 =over 4
 164
 165 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
 166
 167 =item 2. add the biblionumber and biblioitemnumber into the MARC records
 168
 169 =item 3. save the marc record
 170
 171 =back
 172
 173 When dealing with items, we must :
 174
 175 =over 4
 176
 177 =item 1. save the item in items table, that gives us an itemnumber
 178
 179 =item 2. add the itemnumber to the item MARC field
 180
 181 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
 182
 183 When modifying a biblio or an item, the behaviour is quite similar.
 184
 185 =back
 186
 187 =head1 EXPORTED FUNCTIONS
 188
 189 =head2 AddBiblio
 190
 191 =over 4
 192
 193 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
 194
 195 =back
 196
 197 Exported function (core API) for adding a new biblio to koha.
 198
 199 The first argument is a C<MARC::Record> object containing the
 200 bib to add, while the second argument is the desired MARC
 201 framework code.
 202
 203 This function also accepts a third, optional argument: a hashref
 204 to additional options.  The only defined option is C<defer_marc_save>,
 205 which if present and mapped to a true value, causes C<AddBiblio>
 206 to omit the call to save the MARC in C<bibilioitems.marc>
 207 and C<biblioitems.marcxml>  This option is provided B<only>
 208 for the use of scripts such as C<bulkmarcimport.pl> that may need
 209 to do some manipulation of the MARC record for item parsing before
 210 saving it and which cannot afford the performance hit of saving
 211 the MARC record twice.  Consequently, do not use that option
 212 unless you can guarantee that C<ModBiblioMarc> will be called.
 213
 214 =cut
 215
 216 sub AddBiblio {
 217     my $record = shift;
 218     my $frameworkcode = shift;
 219     my $options = @_ ? shift : undef;
 220     my $defer_marc_save = 0;
 221     if (defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'}) {
 222         $defer_marc_save = 1;
 223     }
 224
 225     my ($biblionumber,$biblioitemnumber,$error);
 226     my $dbh = C4::Context->dbh;
 227     # transform the data into koha-table style data
 228     my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 229     ($biblionumber,$error) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
 230     $olddata->{'biblionumber'} = $biblionumber;
 231     ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $olddata );
 232
 233     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 234
 235     # update MARC subfield that stores biblioitems.cn_sort
 236     _koha_marc_update_biblioitem_cn_sort($record, $olddata, $frameworkcode);
 237
 238     # now add the record
 239     $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
 240
 241     logaction("CATALOGUING", "ADD", $biblionumber, "biblio") if C4::Context->preference("CataloguingLog");
 242
 243     return ( $biblionumber, $biblioitemnumber );
 244 }
 245
 246 =head2 ModBiblio
 247
 248 =over 4
 249
 250     ModBiblio( $record,$biblionumber,$frameworkcode);
 251
 252 =back
 253
 254 Replace an existing bib record identified by C<$biblionumber>
 255 with one supplied by the MARC::Record object C<$record>.  The embedded
 256 item, biblioitem, and biblionumber fields from the previous
 257 version of the bib record replace any such fields of those tags that
 258 are present in C<$record>.  Consequently, ModBiblio() is not
 259 to be used to try to modify item records.
 260
 261 C<$frameworkcode> specifies the MARC framework to use
 262 when storing the modified bib record; among other things,
 263 this controls how MARC fields get mapped to display columns
 264 in the C<biblio> and C<biblioitems> tables, as well as
 265 which fields are used to store embedded item, biblioitem,
 266 and biblionumber data for indexing.
 267
 268 =cut
 269
 270 sub ModBiblio {
 271     my ( $record, $biblionumber, $frameworkcode ) = @_;
 272     if (C4::Context->preference("CataloguingLog")) {
 273         my $newrecord = GetMarcBiblio($biblionumber);
 274         logaction("CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>".$newrecord->as_formatted);
 275     }
 276
 277     my $dbh = C4::Context->dbh;
 278
 279     $frameworkcode = "" unless $frameworkcode;
 280
 281     # get the items before and append them to the biblio before updating the record, atm we just have the biblio
 282     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 283     my $oldRecord = GetMarcBiblio( $biblionumber );
 284
 285     # delete any item fields from incoming record to avoid
 286     # duplication or incorrect data - use AddItem() or ModItem()
 287     # to change items
 288     foreach my $field ($record->field($itemtag)) {
 289         $record->delete_field($field);
 290     }
 291
 292     # parse each item, and, for an unknown reason, re-encode each subfield
 293     # if you don't do that, the record will have encoding mixed
 294     # and the biblio will be re-encoded.
 295     # strange, I (Paul P.) searched more than 1 day to understand what happends
 296     # but could only solve the problem this way...
 297    my @fields = $oldRecord->field( $itemtag );
 298     foreach my $fielditem ( @fields ){
 299         my $field;
 300         foreach ($fielditem->subfields()) {
 301             if ($field) {
 302                 $field->add_subfields(Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
 303             } else {
 304                 $field = MARC::Field->new("$itemtag",'','',Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
 305             }
 306           }
 307         $record->append_fields($field);
 308     }
 309
 310     # update biblionumber and biblioitemnumber in MARC
 311     # FIXME - this is assuming a 1 to 1 relationship between
 312     # biblios and biblioitems
 313     my $sth =  $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 314     $sth->execute($biblionumber);
 315     my ($biblioitemnumber) = $sth->fetchrow;
 316     $sth->finish();
 317     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 318
 319     # load the koha-table data object
 320     my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 321
 322     # update MARC subfield that stores biblioitems.cn_sort
 323     _koha_marc_update_biblioitem_cn_sort($record, $oldbiblio, $frameworkcode);
 324
 325     # update the MARC record (that now contains biblio and items) with the new record data
 326     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 327
 328     # modify the other koha tables
 329     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
 330     _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
 331     return 1;
 332 }
 333
 334 =head2 ModBiblioframework
 335
 336     ModBiblioframework($biblionumber,$frameworkcode);
 337     Exported function to modify a biblio framework
 338
 339 =cut
 340
 341 sub ModBiblioframework {
 342     my ( $biblionumber, $frameworkcode ) = @_;
 343     my $dbh = C4::Context->dbh;
 344     my $sth = $dbh->prepare(
 345         "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?"
 346     );
 347     $sth->execute($frameworkcode, $biblionumber);
 348     return 1;
 349 }
 350
 351 =head2 DelBiblio
 352
 353 =over
 354
 355 my $error = &DelBiblio($dbh,$biblionumber);
 356 Exported function (core API) for deleting a biblio in koha.
 357 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
 358 Also backs it up to deleted* tables
 359 Checks to make sure there are not issues on any of the items
 360 return:
 361 C<$error> : undef unless an error occurs
 362
 363 =back
 364
 365 =cut
 366
 367 sub DelBiblio {
 368     my ( $biblionumber ) = @_;
 369     my $dbh = C4::Context->dbh;
 370     my $error;    # for error handling
 371
 372     # First make sure this biblio has no items attached
 373     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
 374     $sth->execute($biblionumber);
 375     if (my $itemnumber = $sth->fetchrow){
 376         # Fix this to use a status the template can understand
 377         $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
 378     }
 379
 380     return $error if $error;
 381
 382     # We delete attached subscriptions
 383     my $subscriptions = &C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
 384     foreach my $subscription (@$subscriptions){
 385         &C4::Serials::DelSubscription($subscription->{subscriptionid});
 386     }
 387
 388     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
 389     # for at least 2 reasons :
 390     # - we need to read the biblio if NoZebra is set (to remove it from the indexes
 391     # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
 392     #   and we would have no way to remove it (except manually in zebra, but I bet it would be very hard to handle the problem)
 393     my $oldRecord;
 394     if (C4::Context->preference("NoZebra")) {
 395         # only NoZebra indexing needs to have
 396         # the previous version of the record
 397         $oldRecord = GetMarcBiblio($biblionumber);
 398     }
 399     ModZebra($biblionumber, "recordDelete", "biblioserver", $oldRecord, undef);
 400
 401     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
 402     $sth =
 403       $dbh->prepare(
 404         "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 405     $sth->execute($biblionumber);
 406     while ( my $biblioitemnumber = $sth->fetchrow ) {
 407
 408         # delete this biblioitem
 409         $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
 410         return $error if $error;
 411     }
 412
 413     # delete biblio from Koha tables and save in deletedbiblio
 414     # must do this *after* _koha_delete_biblioitems, otherwise
 415     # delete cascade will prevent deletedbiblioitems rows
 416     # from being generated by _koha_delete_biblioitems
 417     $error = _koha_delete_biblio( $dbh, $biblionumber );
 418
 419     logaction("CATALOGUING", "DELETE", $biblionumber, "") if C4::Context->preference("CataloguingLog");
 420
 421     return;
 422 }
 423
 424 =head2 LinkBibHeadingsToAuthorities
 425
 426 =over 4
 427
 428 my $headings_linked = LinkBibHeadingsToAuthorities($marc);
 429
 430 =back
 431
 432 Links bib headings to authority records by checking
 433 each authority-controlled field in the C<MARC::Record>
 434 object C<$marc>, looking for a matching authority record,
 435 and setting the linking subfield $9 to the ID of that
 436 authority record.
 437
 438 If no matching authority exists, or if multiple
 439 authorities match, no $9 will be added, and any
 440 existing one inthe field will be deleted.
 441
 442 Returns the number of heading links changed in the
 443 MARC record.
 444
 445 =cut
 446
 447 sub LinkBibHeadingsToAuthorities {
 448     my $bib = shift;
 449
 450     my $num_headings_changed = 0;
 451     foreach my $field ($bib->fields()) {
 452         my $heading = C4::Heading->new_from_bib_field($field);
 453         next unless defined $heading;
 454
 455         # check existing $9
 456         my $current_link = $field->subfield('9');
 457
 458         # look for matching authorities
 459         my $authorities = $heading->authorities();
 460
 461         # want only one exact match
 462         if ($#{ $authorities } == 0) {
 463             my $authority = MARC::Record->new_from_usmarc($authorities->[0]);
 464             my $authid = $authority->field('001')->data();
 465             next if defined $current_link and $current_link eq $authid;
 466
 467             $field->delete_subfield(code => '9') if defined $current_link;
 468             $field->add_subfields('9', $authid);
 469             $num_headings_changed++;
 470         } else {
 471             if (defined $current_link) {
 472                 $field->delete_subfield(code => '9');
 473                 $num_headings_changed++;
 474             }
 475         }
 476
 477     }
 478     return $num_headings_changed;
 479 }
 480
 481 =head2 GetBiblioData
 482
 483 =over 4
 484
 485 $data = &GetBiblioData($biblionumber);
 486 Returns information about the book with the given biblionumber.
 487 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
 488 the C<biblio> and C<biblioitems> tables in the
 489 Koha database.
 490 In addition, C<$data-E<gt>{subject}> is the list of the book's
 491 subjects, separated by C<" , "> (space, comma, space).
 492 If there are multiple biblioitems with the given biblionumber, only
 493 the first one is considered.
 494
 495 =back
 496
 497 =cut
 498
 499 sub GetBiblioData {
 500     my ( $bibnum ) = @_;
 501     my $dbh = C4::Context->dbh;
 502
 503   #  my $query =  C4::Context->preference('item-level_itypes') ?
 504     #   " SELECT * , biblioitems.notes AS bnotes, biblio.notes
 505     #       FROM biblio
 506     #        LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 507     #       WHERE biblio.biblionumber = ?
 508     #        AND biblioitems.biblionumber = biblio.biblionumber
 509     #";
 510
 511     my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
 512             FROM biblio
 513             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 514             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
 515             WHERE biblio.biblionumber = ?
 516             AND biblioitems.biblionumber = biblio.biblionumber ";
 517
 518     my $sth = $dbh->prepare($query);
 519     $sth->execute($bibnum);
 520     my $data;
 521     $data = $sth->fetchrow_hashref;
 522     $sth->finish;
 523
 524     return ($data);
 525 }    # sub GetBiblioData
 526
 527 =head2 &GetBiblioItemData
 528
 529 =over 4
 530
 531 $itemdata = &GetBiblioItemData($biblioitemnumber);
 532
 533 Looks up the biblioitem with the given biblioitemnumber. Returns a
 534 reference-to-hash. The keys are the fields from the C<biblio>,
 535 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
 536 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
 537
 538 =back
 539
 540 =cut
 541
 542 #'
 543 sub GetBiblioItemData {
 544     my ($biblioitemnumber) = @_;
 545     my $dbh       = C4::Context->dbh;
 546     my $query = "SELECT *,biblioitems.notes AS bnotes
 547         FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber ";
 548     unless(C4::Context->preference('item-level_itypes')) {
 549         $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
 550     }
 551     $query .= " WHERE biblioitemnumber = ? ";
 552     my $sth       =  $dbh->prepare($query);
 553     my $data;
 554     $sth->execute($biblioitemnumber);
 555     $data = $sth->fetchrow_hashref;
 556     $sth->finish;
 557     return ($data);
 558 }    # sub &GetBiblioItemData
 559
 560 =head2 GetBiblioItemByBiblioNumber
 561
 562 =over 4
 563
 564 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
 565
 566 =back
 567
 568 =cut
 569
 570 sub GetBiblioItemByBiblioNumber {
 571     my ($biblionumber) = @_;
 572     my $dbh = C4::Context->dbh;
 573     my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
 574     my $count = 0;
 575     my @results;
 576
 577     $sth->execute($biblionumber);
 578
 579     while ( my $data = $sth->fetchrow_hashref ) {
 580         push @results, $data;
 581     }
 582
 583     $sth->finish;
 584     return @results;
 585 }
 586
 587 =head2 GetBiblioFromItemNumber
 588
 589 =over 4
 590
 591 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
 592
 593 Looks up the item with the given itemnumber. if undef, try the barcode.
 594
 595 C<&itemnodata> returns a reference-to-hash whose keys are the fields
 596 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
 597 database.
 598
 599 =back
 600
 601 =cut
 602
 603 #'
 604 sub GetBiblioFromItemNumber {
 605     my ( $itemnumber, $barcode ) = @_;
 606     my $dbh = C4::Context->dbh;
 607     my $sth;
 608     if($itemnumber) {
 609         $sth=$dbh->prepare(  "SELECT * FROM items
 610             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
 611             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
 612              WHERE items.itemnumber = ?") ;
 613         $sth->execute($itemnumber);
 614     } else {
 615         $sth=$dbh->prepare(  "SELECT * FROM items
 616             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
 617             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
 618              WHERE items.barcode = ?") ;
 619         $sth->execute($barcode);
 620     }
 621     my $data = $sth->fetchrow_hashref;
 622     $sth->finish;
 623     return ($data);
 624 }
 625
 626 =head2 GetISBDView
 627
 628 =over 4
 629
 630 $isbd = &GetISBDView($biblionumber);
 631
 632 Return the ISBD view which can be included in opac and intranet
 633
 634 =back
 635
 636 =cut
 637
 638 sub GetISBDView {
 639     my $biblionumber    = shift;
 640     my $record          = GetMarcBiblio($biblionumber);
 641     my $itemtype        = &GetFrameworkCode($biblionumber);
 642     my ($holdingbrtagf,$holdingbrtagsubf) = &GetMarcFromKohaField("items.holdingbranch",$itemtype);
 643     my $tagslib      = &GetMarcStructure( 1, $itemtype );
 644
 645     my $ISBD = C4::Context->preference('ISBD');
 646     my $bloc = $ISBD;
 647     my $res;
 648     my $blocres;
 649
 650     foreach my $isbdfield ( split (/#/, $bloc) ) {
 651
 652         #         $isbdfield= /(.?.?.?)/;
 653         $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/;
 654         my $fieldvalue    = $1 || 0;
 655         my $subfvalue     = $2 || "";
 656         my $textbefore    = $3;
 657         my $analysestring = $4;
 658         my $textafter     = $5;
 659
 660         #         warn "==> $1 / $2 / $3 / $4";
 661         #         my $fieldvalue=substr($isbdfield,0,3);
 662         if ( $fieldvalue > 0 ) {
 663             my $hasputtextbefore = 0;
 664             my @fieldslist = $record->field($fieldvalue);
 665             @fieldslist = sort {$a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf)} @fieldslist if ($fieldvalue eq $holdingbrtagf);
 666
 667             #         warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
 668             #             warn "FV : $fieldvalue";
 669             if ($subfvalue ne ""){
 670               foreach my $field ( @fieldslist ) {
 671                 foreach my $subfield ($field->subfield($subfvalue)){
 672                   my $calculated = $analysestring;
 673                   my $tag        = $field->tag();
 674                   if ( $tag < 10 ) {
 675                   }
 676                   else {
 677                     my $subfieldvalue =
 678                     GetAuthorisedValueDesc( $tag, $subfvalue,
 679                       $subfield, '', $tagslib );
 680                     my $tagsubf = $tag . $subfvalue;
 681                     $calculated =~
 682                           s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
 683                     $calculated =~s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g;
 684
 685                     # field builded, store the result
 686                     if ( $calculated && !$hasputtextbefore )
 687                     {    # put textbefore if not done
 688                     $blocres .= $textbefore;
 689                     $hasputtextbefore = 1;
 690                     }
 691
 692                     # remove punctuation at start
 693                     $calculated =~ s/^( |;|:|\.|-)*//g;
 694                     $blocres .= $calculated;
 695
 696                   }
 697                 }
 698               }
 699               $blocres .= $textafter if $hasputtextbefore;
 700             } else {
 701             foreach my $field ( @fieldslist ) {
 702               my $calculated = $analysestring;
 703               my $tag        = $field->tag();
 704               if ( $tag < 10 ) {
 705               }
 706               else {
 707                 my @subf = $field->subfields;
 708                 for my $i ( 0 .. $#subf ) {
 709                 my $valuecode   = $subf[$i][1];
 710                 my $subfieldcode  = $subf[$i][0];
 711                 my $subfieldvalue =
 712                 GetAuthorisedValueDesc( $tag, $subf[$i][0],
 713                   $subf[$i][1], '', $tagslib );
 714                 my $tagsubf = $tag . $subfieldcode;
 715
 716                 $calculated =~ s/                  # replace all {{}} codes by the value code.
 717                                   \{\{$tagsubf\}\} # catch the {{actualcode}}
 718                                 /
 719                                   $valuecode     # replace by the value code
 720                                /gx;
 721
 722                 $calculated =~
 723             s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g;
 724             $calculated =~s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g;
 725                 }
 726
 727                 # field builded, store the result
 728                 if ( $calculated && !$hasputtextbefore )
 729                 {    # put textbefore if not done
 730                 $blocres .= $textbefore;
 731                 $hasputtextbefore = 1;
 732                 }
 733
 734                 # remove punctuation at start
 735                 $calculated =~ s/^( |;|:|\.|-)*//g;
 736                 $blocres .= $calculated;
 737               }
 738             }
 739             $blocres .= $textafter if $hasputtextbefore;
 740             }
 741         }
 742         else {
 743             $blocres .= $isbdfield;
 744         }
 745     }
 746     $res .= $blocres;
 747
 748     $res =~ s/\{(.*?)\}//g;
 749     $res =~ s/\\n/\n/g;
 750     $res =~ s/\n/<br\/>/g;
 751
 752     # remove empty ()
 753     $res =~ s/\(\)//g;
 754
 755     return $res;
 756 }
 757
 758 =head2 GetBiblio
 759
 760 =over 4
 761
 762 ( $count, @results ) = &GetBiblio($biblionumber);
 763
 764 =back
 765
 766 =cut
 767
 768 sub GetBiblio {
 769     my ($biblionumber) = @_;
 770     my $dbh = C4::Context->dbh;
 771     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
 772     my $count = 0;
 773     my @results;
 774     $sth->execute($biblionumber);
 775     while ( my $data = $sth->fetchrow_hashref ) {
 776         $results[$count] = $data;
 777         $count++;
 778     }    # while
 779     $sth->finish;
 780     return ( $count, @results );
 781 }    # sub GetBiblio
 782
 783 =head2 GetBiblioItemInfosOf
 784
 785 =over 4
 786
 787 GetBiblioItemInfosOf(@biblioitemnumbers);
 788
 789 =back
 790
 791 =cut
 792
 793 sub GetBiblioItemInfosOf {
 794     my @biblioitemnumbers = @_;
 795
 796     my $query = '
 797         SELECT biblioitemnumber,
 798             publicationyear,
 799             itemtype
 800         FROM biblioitems
 801         WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
 802     ';
 803     return get_infos_of( $query, 'biblioitemnumber' );
 804 }
 805
 806 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
 807
 808 =head2 GetMarcStructure
 809
 810 =over 4
 811
 812 $res = GetMarcStructure($forlibrarian,$frameworkcode);
 813
 814 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
 815 $forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
 816 $frameworkcode : the framework code to read
 817
 818 =back
 819
 820 =cut
 821
 822 # cache for results of GetMarcStructure -- needed
 823 # for batch jobs
 824 our $marc_structure_cache;
 825
 826 sub GetMarcStructure {
 827     my ( $forlibrarian, $frameworkcode ) = @_;
 828     my $dbh=C4::Context->dbh;
 829     $frameworkcode = "" unless $frameworkcode;
 830
 831     if (defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode}) {
 832         return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
 833     }
 834
 835     my $sth;
 836     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 837
 838     # check that framework exists
 839     $sth =
 840       $dbh->prepare(
 841         "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
 842     $sth->execute($frameworkcode);
 843     my ($total) = $sth->fetchrow;
 844     $frameworkcode = "" unless ( $total > 0 );
 845     $sth =
 846       $dbh->prepare(
 847         "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
 848         FROM marc_tag_structure
 849         WHERE frameworkcode=?
 850         ORDER BY tagfield"
 851       );
 852     $sth->execute($frameworkcode);
 853     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 854
 855     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) =
 856         $sth->fetchrow )
 857     {
 858         $res->{$tag}->{lib} =
 859           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
 860         $res->{$tag}->{tab}        = "";
 861         $res->{$tag}->{mandatory}  = $mandatory;
 862         $res->{$tag}->{repeatable} = $repeatable;
 863     }
 864
 865     $sth =
 866       $dbh->prepare(
 867             "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue
 868                 FROM marc_subfield_structure
 869             WHERE frameworkcode=?
 870                 ORDER BY tagfield,tagsubfield
 871             "
 872     );
 873
 874     $sth->execute($frameworkcode);
 875
 876     my $subfield;
 877     my $authorised_value;
 878     my $authtypecode;
 879     my $value_builder;
 880     my $kohafield;
 881     my $seealso;
 882     my $hidden;
 883     my $isurl;
 884     my $link;
 885     my $defaultvalue;
 886
 887     while (
 888         (
 889             $tag,          $subfield,      $liblibrarian,
 890             ,              $libopac,       $tab,
 891             $mandatory,    $repeatable,    $authorised_value,
 892             $authtypecode, $value_builder, $kohafield,
 893             $seealso,      $hidden,        $isurl,
 894             $link,$defaultvalue
 895         )
 896         = $sth->fetchrow
 897       )
 898     {
 899         $res->{$tag}->{$subfield}->{lib} =
 900           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
 901         $res->{$tag}->{$subfield}->{tab}              = $tab;
 902         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 903         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 904         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 905         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 906         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 907         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 908         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 909         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 910         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 911         $res->{$tag}->{$subfield}->{'link'}           = $link;
 912         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
 913     }
 914
 915     $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
 916
 917     return $res;
 918 }
 919
 920 =head2 GetUsedMarcStructure
 921
 922     the same function as GetMarcStructure expcet it just take field
 923     in tab 0-9. (used field)
 924
 925     my $results = GetUsedMarcStructure($frameworkcode);
 926
 927     L<$results> is a ref to an array which each case containts a ref
 928     to a hash which each keys is the columns from marc_subfield_structure
 929
 930     L<$frameworkcode> is the framework code.
 931
 932 =cut
 933
 934 sub GetUsedMarcStructure($){
 935     my $frameworkcode = shift || '';
 936     my $dbh           = C4::Context->dbh;
 937     my $query         = qq/
 938         SELECT *
 939         FROM   marc_subfield_structure
 940         WHERE   tab > -1
 941             AND frameworkcode = ?
 942     /;
 943     my @results;
 944     my $sth = $dbh->prepare($query);
 945     $sth->execute($frameworkcode);
 946     while (my $row = $sth->fetchrow_hashref){
 947         push @results,$row;
 948     }
 949     return \@results;
 950 }
 951
 952 =head2 GetMarcFromKohaField
 953
 954 =over 4
 955
 956 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
 957 Returns the MARC fields & subfields mapped to the koha field
 958 for the given frameworkcode
 959
 960 =back
 961
 962 =cut
 963
 964 sub GetMarcFromKohaField {
 965     my ( $kohafield, $frameworkcode ) = @_;
 966     return 0, 0 unless $kohafield and defined $frameworkcode;
 967     my $relations = C4::Context->marcfromkohafield;
 968     return (
 969         $relations->{$frameworkcode}->{$kohafield}->[0],
 970         $relations->{$frameworkcode}->{$kohafield}->[1]
 971     );
 972 }
 973
 974 =head2 GetMarcBiblio
 975
 976 =over 4
 977
 978 my $record = GetMarcBiblio($biblionumber);
 979
 980 =back
 981
 982 Returns MARC::Record representing bib identified by
 983 C<$biblionumber>.  If no bib exists, returns undef.
 984 The MARC record contains both biblio & item data.
 985
 986 =cut
 987
 988 sub GetMarcBiblio {
 989     my $biblionumber = shift;
 990     my $dbh          = C4::Context->dbh;
 991     my $sth          =
 992       $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
 993     $sth->execute($biblionumber);
 994     my $row = $sth->fetchrow_hashref;
 995     my $marcxml = StripNonXmlChars($row->{'marcxml'});
 996      MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
 997     my $record = MARC::Record->new();
 998     if ($marcxml) {
 999         $record = eval {MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour'))};
1000         if ($@) {warn " problem with :$biblionumber : $@ \n$marcxml";}
1001 #      $record = MARC::Record::new_from_usmarc( $marc) if $marc;
1002         return $record;
1003     } else {
1004         return undef;
1005     }
1006 }
1007
1008 =head2 GetXmlBiblio
1009
1010 =over 4
1011
1012 my $marcxml = GetXmlBiblio($biblionumber);
1013
1014 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1015 The XML contains both biblio & item datas
1016
1017 =back
1018
1019 =cut
1020
1021 sub GetXmlBiblio {
1022     my ( $biblionumber ) = @_;
1023     my $dbh = C4::Context->dbh;
1024     my $sth =
1025       $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1026     $sth->execute($biblionumber);
1027     my ($marcxml) = $sth->fetchrow;
1028     return $marcxml;
1029 }
1030
1031 =head2 GetCOinSBiblio
1032
1033 =over 4
1034
1035 my $coins = GetCOinSBiblio($biblionumber);
1036
1037 Returns the COinS(a span) which can be included in a biblio record
1038
1039 =back
1040
1041 =cut
1042
1043 sub GetCOinSBiblio {
1044     my ( $biblionumber ) = @_;
1045     my $record = GetMarcBiblio($biblionumber);
1046
1047     # get the coin format
1048     my $pos7 = substr $record->leader(), 7,1;
1049     my $pos6 = substr $record->leader(), 6,1;
1050     my $mtx;
1051     my $genre;
1052     my ($aulast, $aufirst) = ('','');
1053     my $oauthors;
1054     my $title;
1055     my $subtitle;
1056     my $pubyear;
1057     my $isbn;
1058     my $issn;
1059     my $publisher;
1060
1061     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ){
1062         my $fmts6;
1063         my $fmts7;
1064         %$fmts6 = (
1065                     'a' => 'book',
1066                     'b' => 'manuscript',
1067                     'c' => 'book',
1068                     'd' => 'manuscript',
1069                     'e' => 'map',
1070                     'f' => 'map',
1071                     'g' => 'film',
1072                     'i' => 'audioRecording',
1073                     'j' => 'audioRecording',
1074                     'k' => 'artwork',
1075                     'l' => 'document',
1076                     'm' => 'computerProgram',
1077                     'r' => 'document',
1078
1079                 );
1080         %$fmts7 = (
1081                     'a' => 'journalArticle',
1082                     's' => 'journal',
1083                 );
1084
1085         $genre =  $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book' ;
1086
1087         if( $genre eq 'book' ){
1088             $genre =  $fmts7->{$pos7} if $fmts7->{$pos7};
1089         }
1090
1091         ##### We must transform mtx to a valable mtx and document type ####
1092         if( $genre eq 'book' ){
1093             $mtx = 'book';
1094         }elsif( $genre eq 'journal' ){
1095             $mtx = 'journal';
1096         }elsif( $genre eq 'journalArticle' ){
1097             $mtx = 'journal';
1098             $genre = 'article';
1099         }else{
1100             $mtx = 'dc';
1101         }
1102
1103         $genre = ($mtx eq 'dc') ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
1104
1105         # Setting datas
1106         $aulast     = $record->subfield('700','a');
1107         $aufirst    = $record->subfield('700','b');
1108         $oauthors   = "&amp;rft.au=$aufirst $aulast";
1109         # others authors
1110         if($record->field('200')){
1111             for my $au ($record->field('200')->subfield('g')){
1112                 $oauthors .= "&amp;rft.au=$au";
1113             }
1114         }
1115         $title      = ( $mtx eq 'dc' ) ? "&amp;rft.title=".$record->subfield('200','a') :
1116                                          "&amp;rft.title=".$record->subfield('200','a')."&amp;rft.btitle=".$record->subfield('200','a');
1117         $pubyear    = $record->subfield('210','d');
1118         $publisher  = $record->subfield('210','c');
1119         $isbn       = $record->subfield('010','a');
1120         $issn       = $record->subfield('011','a');
1121     }else{
1122         # MARC21 need some improve
1123         my $fmts;
1124         $mtx = 'book';
1125         $genre = "&amp;rft.genre=book";
1126
1127         # Setting datas
1128         $oauthors .= "&amp;rft.au=".$record->subfield('100','a');
1129         # others authors
1130         if($record->field('700')){
1131             for my $au ($record->field('700')->subfield('a')){
1132                 $oauthors .= "&amp;rft.au=$au";
1133             }
1134         }
1135         $title      = "&amp;rft.btitle=".$record->subfield('245','a');
1136         $subtitle   = $record->subfield('245', 'b') || '';
1137         $title .= $subtitle;
1138         $pubyear    = $record->subfield('260', 'c') || '';
1139         $publisher  = $record->subfield('260', 'b') || '';
1140         $isbn       = $record->subfield('020', 'a') || '';
1141         $issn       = $record->subfield('022', 'a') || '';
1142
1143     }
1144     my $coins_value = "ctx_ver=Z39.88-2004&amp;rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&amp;rft.isbn=$isbn&amp;rft.issn=$issn&amp;rft.aulast=$aulast&amp;rft.aufirst=$aufirst$oauthors&amp;rft.pub=$publisher&amp;rft.date=$pubyear";
1145     $coins_value =~ s/(\ |&[^a])/\+/g;
1146     #<!-- TMPL_VAR NAME="ocoins_format" -->&amp;rft.au=<!-- TMPL_VAR NAME="author" -->&amp;rft.btitle=<!-- TMPL_VAR NAME="title" -->&amp;rft.date=<!-- TMPL_VAR NAME="publicationyear" -->&amp;rft.pages=<!-- TMPL_VAR NAME="pages" -->&amp;rft.isbn=<!-- TMPL_VAR NAME=amazonisbn -->&amp;rft.aucorp=&amp;rft.place=<!-- TMPL_VAR NAME="place" -->&amp;rft.pub=<!-- TMPL_VAR NAME="publishercode" -->&amp;rft.edition=<!-- TMPL_VAR NAME="edition" -->&amp;rft.series=<!-- TMPL_VAR NAME="series" -->&amp;rft.genre="
1147
1148     return $coins_value;
1149 }
1150
1151 =head2 GetAuthorisedValueDesc
1152
1153 =over 4
1154
1155 my $subfieldvalue =get_authorised_value_desc(
1156     $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category);
1157 Retrieve the complete description for a given authorised value.
1158
1159 Now takes $category and $value pair too.
1160 my $auth_value_desc =GetAuthorisedValueDesc(
1161     '','', 'DVD' ,'','','CCODE');
1162
1163 =back
1164
1165 =cut
1166
1167 sub GetAuthorisedValueDesc {
1168     my ( $tag, $subfield, $value, $framework, $tagslib, $category ) = @_;
1169     my $dbh = C4::Context->dbh;
1170
1171     if (!$category) {
1172
1173         return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1174
1175 #---- branch
1176         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1177             return C4::Branch::GetBranchName($value);
1178         }
1179
1180 #---- itemtypes
1181         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1182             return getitemtypeinfo($value)->{description};
1183         }
1184
1185 #---- "true" authorized value
1186         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'}
1187     }
1188
1189     if ( $category ne "" ) {
1190         my $sth =
1191             $dbh->prepare(
1192                     "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
1193                     );
1194         $sth->execute( $category, $value );
1195         my $data = $sth->fetchrow_hashref;
1196         return $data->{'lib'};
1197     }
1198     else {
1199         return $value;    # if nothing is found return the original value
1200     }
1201 }
1202
1203 =head2 GetMarcNotes
1204
1205 =over 4
1206
1207 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1208 Get all notes from the MARC record and returns them in an array.
1209 The note are stored in differents places depending on MARC flavour
1210
1211 =back
1212
1213 =cut
1214
1215 sub GetMarcNotes {
1216     my ( $record, $marcflavour ) = @_;
1217     my $scope;
1218     if ( $marcflavour eq "MARC21" ) {
1219         $scope = '5..';
1220     }
1221     else {    # assume unimarc if not marc21
1222         $scope = '3..';
1223     }
1224     my @marcnotes;
1225     my $note = "";
1226     my $tag  = "";
1227     my $marcnote;
1228     foreach my $field ( $record->field($scope) ) {
1229         my $value = $field->as_string();
1230         if ( $note ne "" ) {
1231             $marcnote = { marcnote => $note, };
1232             push @marcnotes, $marcnote;
1233             $note = $value;
1234         }
1235         if ( $note ne $value ) {
1236             $note = $note . " " . $value;
1237         }
1238     }
1239
1240     if ( $note ) {
1241         $marcnote = { marcnote => $note };
1242         push @marcnotes, $marcnote;    #load last tag into array
1243     }
1244     return \@marcnotes;
1245 }    # end GetMarcNotes
1246
1247 =head2 GetMarcSubjects
1248
1249 =over 4
1250
1251 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1252 Get all subjects from the MARC record and returns them in an array.
1253 The subjects are stored in differents places depending on MARC flavour
1254
1255 =back
1256
1257 =cut
1258
1259 sub GetMarcSubjects {
1260     my ( $record, $marcflavour ) = @_;
1261     my ( $mintag, $maxtag );
1262     if ( $marcflavour eq "MARC21" ) {
1263         $mintag = "600";
1264         $maxtag = "699";
1265     }
1266     else {    # assume unimarc if not marc21
1267         $mintag = "600";
1268         $maxtag = "611";
1269     }
1270
1271     my @marcsubjects;
1272     my $subject = "";
1273     my $subfield = "";
1274     my $marcsubject;
1275
1276     foreach my $field ( $record->field('6..' )) {
1277         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1278         my @subfields_loop;
1279         my @subfields = $field->subfields();
1280         my $counter = 0;
1281         my @link_loop;
1282         # if there is an authority link, build the link with an= subfield9
1283         my $subfield9 = $field->subfield('9');
1284         for my $subject_subfield (@subfields ) {
1285             # don't load unimarc subfields 3,4,5
1286             next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ /3|4|5/ ) );
1287             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1288             next if (($marcflavour eq "MARC21")  and ($subject_subfield->[0] =~ /2/ ) );
1289             my $code = $subject_subfield->[0];
1290             my $value = $subject_subfield->[1];
1291             my $linkvalue = $value;
1292             $linkvalue =~ s/(\(|\))//g;
1293             my $operator = " and " unless $counter==0;
1294             if ($subfield9) {
1295                 @link_loop = ({'limit' => 'an' ,link => "$subfield9" });
1296             } else {
1297                 push @link_loop, {'limit' => 'su', link => $linkvalue, operator => $operator };
1298             }
1299             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1300             # ignore $9
1301             my @this_link_loop = @link_loop;
1302             push @subfields_loop, {code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($subject_subfield->[0] eq 9 );
1303             $counter++;
1304         }
1305
1306         push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1307
1308     }
1309         return \@marcsubjects;
1310 }  #end getMARCsubjects
1311
1312 =head2 GetMarcAuthors
1313
1314 =over 4
1315
1316 authors = GetMarcAuthors($record,$marcflavour);
1317 Get all authors from the MARC record and returns them in an array.
1318 The authors are stored in differents places depending on MARC flavour
1319
1320 =back
1321
1322 =cut
1323
1324 sub GetMarcAuthors {
1325     my ( $record, $marcflavour ) = @_;
1326     my ( $mintag, $maxtag );
1327     # tagslib useful for UNIMARC author reponsabilities
1328     my $tagslib = &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be bugguy on some setups, will be usually correct.
1329     if ( $marcflavour eq "MARC21" ) {
1330         $mintag = "700";
1331         $maxtag = "720";
1332     }
1333     elsif ( $marcflavour eq "UNIMARC" ) {    # assume unimarc if not marc21
1334         $mintag = "700";
1335         $maxtag = "712";
1336     }
1337     else {
1338         return;
1339     }
1340     my @marcauthors;
1341
1342     foreach my $field ( $record->fields ) {
1343         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1344         my @subfields_loop;
1345         my @link_loop;
1346         my @subfields = $field->subfields();
1347         my $count_auth = 0;
1348         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1349         my $subfield9 = $field->subfield('9');
1350         for my $authors_subfield (@subfields) {
1351             # don't load unimarc subfields 3, 5
1352             next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ /3|5/ ) );
1353             my $subfieldcode = $authors_subfield->[0];
1354             my $value = $authors_subfield->[1];
1355             my $linkvalue = $value;
1356             $linkvalue =~ s/(\(|\))//g;
1357             my $operator = " and " unless $count_auth==0;
1358             # if we have an authority link, use that as the link, otherwise use standard searching
1359             if ($subfield9) {
1360                 @link_loop = ({'limit' => 'an' ,link => "$subfield9" });
1361             }
1362             else {
1363                 # reset $linkvalue if UNIMARC author responsibility
1364                 if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq "4")) {
1365                     $linkvalue = "(".GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ).")";
1366                 }
1367                 push @link_loop, {'limit' => 'au', link => $linkvalue, operator => $operator };
1368             }
1369             $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~/4/));
1370             my @this_link_loop = @link_loop;
1371             my $separator = C4::Context->preference("authoritysep") unless $count_auth==0;
1372             push @subfields_loop, {code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($authors_subfield->[0] eq '9' );
1373             $count_auth++;
1374         }
1375         push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
1376     }
1377     return \@marcauthors;
1378 }
1379
1380 =head2 GetMarcUrls
1381
1382 =over 4
1383
1384 $marcurls = GetMarcUrls($record,$marcflavour);
1385 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1386 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1387
1388 =back
1389
1390 =cut
1391
1392 sub GetMarcUrls {
1393     my ( $record, $marcflavour ) = @_;
1394
1395     my @marcurls;
1396     for my $field ( $record->field('856') ) {
1397         my $marcurl;
1398         my @notes;
1399         for my $note ( $field->subfield('z') ) {
1400             push @notes, { note => $note };
1401         }
1402         my @urls = $field->subfield('u');
1403         foreach my $url (@urls) {
1404             if ( $marcflavour eq 'MARC21' ) {
1405                 my $s3   = $field->subfield('3');
1406                 my $link = $field->subfield('y');
1407                 unless ( $url =~ /^\w+:/ ) {
1408                     if ( $field->indicator(1) eq '7' ) {
1409                         $url = $field->subfield('2') . "://" . $url;
1410                     } elsif ( $field->indicator(1) eq '1' ) {
1411                         $url = 'ftp://' . $url;
1412                     } else {
1413                         #  properly, this should be if ind1=4,
1414                         #  however we will assume http protocol since we're building a link.
1415                         $url = 'http://' . $url;
1416                     }
1417                 }
1418                 # TODO handle ind 2 (relationship)
1419                 $marcurl = {
1420                     MARCURL => $url,
1421                     notes   => \@notes,
1422                 };
1423                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1424                 $marcurl->{'part'} = $s3 if ($link);
1425                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1426             } else {
1427                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1428                 $marcurl->{'MARCURL'} = $url;
1429             }
1430             push @marcurls, $marcurl;
1431         }
1432     }
1433     return \@marcurls;
1434 }
1435
1436 =head2 GetMarcSeries
1437
1438 =over 4
1439
1440 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1441 Get all series from the MARC record and returns them in an array.
1442 The series are stored in differents places depending on MARC flavour
1443
1444 =back
1445
1446 =cut
1447
1448 sub GetMarcSeries {
1449     my ($record, $marcflavour) = @_;
1450     my ($mintag, $maxtag);
1451     if ($marcflavour eq "MARC21") {
1452         $mintag = "440";
1453         $maxtag = "490";
1454     } else {           # assume unimarc if not marc21
1455         $mintag = "600";
1456         $maxtag = "619";
1457     }
1458
1459     my @marcseries;
1460     my $subjct = "";
1461     my $subfield = "";
1462     my $marcsubjct;
1463
1464     foreach my $field ($record->field('440'), $record->field('490')) {
1465         my @subfields_loop;
1466         #my $value = $field->subfield('a');
1467         #$marcsubjct = {MARCSUBJCT => $value,};
1468         my @subfields = $field->subfields();
1469         #warn "subfields:".join " ", @$subfields;
1470         my $counter = 0;
1471         my @link_loop;
1472         for my $series_subfield (@subfields) {
1473             my $volume_number;
1474             undef $volume_number;
1475             # see if this is an instance of a volume
1476             if ($series_subfield->[0] eq 'v') {
1477                 $volume_number=1;
1478             }
1479
1480             my $code = $series_subfield->[0];
1481             my $value = $series_subfield->[1];
1482             my $linkvalue = $value;
1483             $linkvalue =~ s/(\(|\))//g;
1484             my $operator = " and " unless $counter==0;
1485             push @link_loop, {link => $linkvalue, operator => $operator };
1486             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1487             if ($volume_number) {
1488             push @subfields_loop, {volumenum => $value};
1489             }
1490             else {
1491             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1492             }
1493             $counter++;
1494         }
1495         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1496         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1497         #push @marcsubjcts, $marcsubjct;
1498         #$subjct = $value;
1499
1500     }
1501     my $marcseriessarray=\@marcseries;
1502     return $marcseriessarray;
1503 }  #end getMARCseriess
1504
1505 =head2 GetFrameworkCode
1506
1507 =over 4
1508
1509     $frameworkcode = GetFrameworkCode( $biblionumber )
1510
1511 =back
1512
1513 =cut
1514
1515 sub GetFrameworkCode {
1516     my ( $biblionumber ) = @_;
1517     my $dbh = C4::Context->dbh;
1518     my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1519     $sth->execute($biblionumber);
1520     my ($frameworkcode) = $sth->fetchrow;
1521     return $frameworkcode;
1522 }
1523
1524 =head2 GetPublisherNameFromIsbn
1525
1526     $name = GetPublishercodeFromIsbn($isbn);
1527     if(defined $name){
1528         ...
1529     }
1530
1531 =cut
1532
1533 sub GetPublisherNameFromIsbn($){
1534     my $isbn = shift;
1535     $isbn =~ s/[- _]//g;
1536     $isbn =~ s/^0*//;
1537     my @codes = (split '-', DisplayISBN($isbn));
1538     my $code = $codes[0].$codes[1].$codes[2];
1539     my $dbh  = C4::Context->dbh;
1540     my $query = qq{
1541         SELECT distinct publishercode
1542         FROM   biblioitems
1543         WHERE  isbn LIKE ?
1544         AND    publishercode IS NOT NULL
1545         LIMIT 1
1546     };
1547     my $sth = $dbh->prepare($query);
1548     $sth->execute("$code%");
1549     my $name = $sth->fetchrow;
1550     return $name if length $name;
1551     return undef;
1552 }
1553
1554 =head2 TransformKohaToMarc
1555
1556 =over 4
1557
1558     $record = TransformKohaToMarc( $hash )
1559     This function builds partial MARC::Record from a hash
1560     Hash entries can be from biblio or biblioitems.
1561     This function is called in acquisition module, to create a basic catalogue entry from user entry
1562
1563 =back
1564
1565 =cut
1566
1567 sub TransformKohaToMarc {
1568     my ( $hash ) = @_;
1569     my $sth = C4::Context->dbh->prepare(
1570         "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
1571     );
1572     my $record = MARC::Record->new();
1573     SetMarcUnicodeFlag($record, C4::Context->preference("marcflavour"));
1574     foreach (keys %{$hash}) {
1575         &TransformKohaToMarcOneField( $sth, $record, $_, $hash->{$_}, '' );
1576     }
1577     return $record;
1578 }
1579
1580 =head2 TransformKohaToMarcOneField
1581
1582 =over 4
1583
1584     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1585
1586 =back
1587
1588 =cut
1589
1590 sub TransformKohaToMarcOneField {
1591     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1592     $frameworkcode='' unless $frameworkcode;
1593     my $tagfield;
1594     my $tagsubfield;
1595
1596     if ( !defined $sth ) {
1597         my $dbh = C4::Context->dbh;
1598         $sth = $dbh->prepare(
1599             "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
1600         );
1601     }
1602     $sth->execute( $frameworkcode, $kohafieldname );
1603     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1604         my $tag = $record->field($tagfield);
1605         if ($tag) {
1606             $tag->update( $tagsubfield => $value );
1607             $record->delete_field($tag);
1608             $record->insert_fields_ordered($tag);
1609         }
1610         else {
1611             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1612         }
1613     }
1614     return $record;
1615 }
1616
1617 =head2 TransformHtmlToXml
1618
1619 =over 4
1620
1621 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type )
1622
1623 $auth_type contains :
1624 - nothing : rebuild a biblio, un UNIMARC the encoding is in 100$a pos 26/27
1625 - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1626 - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1627
1628 =back
1629
1630 =cut
1631
1632 sub TransformHtmlToXml {
1633     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
1634     my $xml = MARC::File::XML::header('UTF-8');
1635     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
1636     MARC::File::XML->default_record_format($auth_type);
1637     # in UNIMARC, field 100 contains the encoding
1638     # check that there is one, otherwise the
1639     # MARC::Record->new_from_xml will fail (and Koha will die)
1640     my $unimarc_and_100_exist=0;
1641     $unimarc_and_100_exist=1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
1642     my $prevvalue;
1643     my $prevtag = -1;
1644     my $first   = 1;
1645     my $j       = -1;
1646     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
1647         if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
1648             # if we have a 100 field and it's values are not correct, skip them.
1649             # if we don't have any valid 100 field, we will create a default one at the end
1650             my $enc = substr( @$values[$i], 26, 2 );
1651             if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
1652                 $unimarc_and_100_exist=1;
1653             } else {
1654                 next;
1655             }
1656         }
1657         @$values[$i] =~ s/&/&amp;/g;
1658         @$values[$i] =~ s/</&lt;/g;
1659         @$values[$i] =~ s/>/&gt;/g;
1660         @$values[$i] =~ s/"/&quot;/g;
1661         @$values[$i] =~ s/'/&apos;/g;
1662 #         if ( !utf8::is_utf8( @$values[$i] ) ) {
1663 #             utf8::decode( @$values[$i] );
1664 #         }
1665         if ( ( @$tags[$i] ne $prevtag ) ) {
1666             $j++ unless ( @$tags[$i] eq "" );
1667             if ( !$first ) {
1668                 $xml .= "</datafield>\n";
1669                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
1670                     && ( @$values[$i] ne "" ) )
1671                 {
1672                     my $ind1 = substr( @$indicator[$j], 0, 1 );
1673                     my $ind2;
1674                     if ( @$indicator[$j] ) {
1675                         $ind2 = substr( @$indicator[$j], 1, 1 );
1676                     }
1677                     else {
1678                         warn "Indicator in @$tags[$i] is empty";
1679                         $ind2 = " ";
1680                     }
1681                     $xml .=
1682 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1683                     $xml .=
1684 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1685                     $first = 0;
1686                 }
1687                 else {
1688                     $first = 1;
1689                 }
1690             }
1691             else {
1692                 if ( @$values[$i] ne "" ) {
1693
1694                     # leader
1695                     if ( @$tags[$i] eq "000" ) {
1696                         $xml .= "<leader>@$values[$i]</leader>\n";
1697                         $first = 1;
1698
1699                         # rest of the fixed fields
1700                     }
1701                     elsif ( @$tags[$i] < 10 ) {
1702                         $xml .=
1703 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
1704                         $first = 1;
1705                     }
1706                     else {
1707                         my $ind1 = substr( @$indicator[$j], 0, 1 );
1708                         my $ind2 = substr( @$indicator[$j], 1, 1 );
1709                         $xml .=
1710 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1711                         $xml .=
1712 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1713                         $first = 0;
1714                     }
1715                 }
1716             }
1717         }
1718         else {    # @$tags[$i] eq $prevtag
1719             if ( @$values[$i] eq "" ) {
1720             }
1721             else {
1722                 if ($first) {
1723                     my $ind1 = substr( @$indicator[$j], 0, 1 );
1724                     my $ind2 = substr( @$indicator[$j], 1, 1 );
1725                     $xml .=
1726 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1727                     $first = 0;
1728                 }
1729                 $xml .=
1730 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1731             }
1732         }
1733         $prevtag = @$tags[$i];
1734     }
1735     $xml .= "</datafield>\n" if @$tags > 0;
1736     if (C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist) {
1737 #     warn "SETTING 100 for $auth_type";
1738         my $string = strftime( "%Y%m%d", localtime(time) );
1739         # set 50 to position 26 is biblios, 13 if authorities
1740         my $pos=26;
1741         $pos=13 if $auth_type eq 'UNIMARCAUTH';
1742         $string = sprintf( "%-*s", 35, $string );
1743         substr( $string, $pos , 6, "50" );
1744         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
1745         $xml .= "<subfield code=\"a\">$string</subfield>\n";
1746         $xml .= "</datafield>\n";
1747     }
1748     $xml .= MARC::File::XML::footer();
1749     return $xml;
1750 }
1751
1752 =head2 TransformHtmlToMarc
1753
1754     L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
1755     L<$params> is a ref to an array as below:
1756     {
1757         'tag_010_indicator1_531951' ,
1758         'tag_010_indicator2_531951' ,
1759         'tag_010_code_a_531951_145735' ,
1760         'tag_010_subfield_a_531951_145735' ,
1761         'tag_200_indicator1_873510' ,
1762         'tag_200_indicator2_873510' ,
1763         'tag_200_code_a_873510_673465' ,
1764         'tag_200_subfield_a_873510_673465' ,
1765         'tag_200_code_b_873510_704318' ,
1766         'tag_200_subfield_b_873510_704318' ,
1767         'tag_200_code_e_873510_280822' ,
1768         'tag_200_subfield_e_873510_280822' ,
1769         'tag_200_code_f_873510_110730' ,
1770         'tag_200_subfield_f_873510_110730' ,
1771     }
1772     L<$cgi> is the CGI object which containts the value.
1773     L<$record> is the MARC::Record object.
1774
1775 =cut
1776
1777 sub TransformHtmlToMarc {
1778     my $params = shift;
1779     my $cgi    = shift;
1780
1781     # explicitly turn on the UTF-8 flag for all
1782     # 'tag_' parameters to avoid incorrect character
1783     # conversion later on
1784     my $cgi_params = $cgi->Vars;
1785     foreach my $param_name (keys %$cgi_params) {
1786         if ($param_name =~ /^tag_/) {
1787             my $param_value = $cgi_params->{$param_name};
1788             if (utf8::decode($param_value)) {
1789                 $cgi_params->{$param_name} = $param_value;
1790             }
1791             # FIXME - need to do something if string is not valid UTF-8
1792         }
1793     }
1794
1795     # creating a new record
1796     my $record  = MARC::Record->new();
1797     my $i=0;
1798     my @fields;
1799     while ($params->[$i]){ # browse all CGI params
1800         my $param = $params->[$i];
1801         my $newfield=0;
1802         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
1803         if ($param eq 'biblionumber') {
1804             my ( $biblionumbertagfield, $biblionumbertagsubfield ) =
1805                 &GetMarcFromKohaField( "biblio.biblionumber", '' );
1806             if ($biblionumbertagfield < 10) {
1807                 $newfield = MARC::Field->new(
1808                     $biblionumbertagfield,
1809                     $cgi->param($param),
1810                 );
1811             } else {
1812                 $newfield = MARC::Field->new(
1813                     $biblionumbertagfield,
1814                     '',
1815                     '',
1816                     "$biblionumbertagsubfield" => $cgi->param($param),
1817                 );
1818             }
1819             push @fields,$newfield if($newfield);
1820         }
1821         elsif ($param =~ /^tag_(\d*)_indicator1_/){ # new field start when having 'input name="..._indicator1_..."
1822             my $tag  = $1;
1823
1824             my $ind1 = substr($cgi->param($param),0,1);
1825             my $ind2 = substr($cgi->param($params->[$i+1]),0,1);
1826             $newfield=0;
1827             my $j=$i+2;
1828
1829             if($tag < 10){ # no code for theses fields
1830     # in MARC editor, 000 contains the leader.
1831                 if ($tag eq '000' ) {
1832                     $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==24;
1833     # between 001 and 009 (included)
1834                 } elsif ($cgi->param($params->[$j+1]) ne '') {
1835                     $newfield = MARC::Field->new(
1836                         $tag,
1837                         $cgi->param($params->[$j+1]),
1838                     );
1839                 }
1840     # > 009, deal with subfields
1841             } else {
1842                 while(defined $params->[$j] && $params->[$j] =~ /_code_/){ # browse all it's subfield
1843                     my $inner_param = $params->[$j];
1844                     if ($newfield){
1845                         if($cgi->param($params->[$j+1]) ne ''){  # only if there is a value (code => value)
1846                             $newfield->add_subfields(
1847                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1])
1848                             );
1849                         }
1850                     } else {
1851                         if ( $cgi->param($params->[$j+1]) ne '' ) { # creating only if there is a value (code => value)
1852                             $newfield = MARC::Field->new(
1853                                 $tag,
1854                                 ''.$ind1,
1855                                 ''.$ind2,
1856                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
1857                             );
1858                         }
1859                     }
1860                     $j+=2;
1861                 }
1862             }
1863             push @fields,$newfield if($newfield);
1864         }
1865         $i++;
1866     }
1867
1868     $record->append_fields(@fields);
1869     return $record;
1870 }
1871
1872 # cache inverted MARC field map
1873 our $inverted_field_map;
1874
1875 =head2 TransformMarcToKoha
1876
1877 =over 4
1878
1879     $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
1880
1881 =back
1882
1883 Extract data from a MARC bib record into a hashref representing
1884 Koha biblio, biblioitems, and items fields.
1885
1886 =cut
1887 sub TransformMarcToKoha {
1888     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
1889
1890     my $result;
1891     $limit_table=$limit_table||0;
1892     $frameworkcode = '' unless defined $frameworkcode;
1893
1894     unless (defined $inverted_field_map) {
1895         $inverted_field_map = _get_inverted_marc_field_map();
1896     }
1897
1898     my %tables = ();
1899     if ( defined $limit_table && $limit_table eq 'items') {
1900         $tables{'items'} = 1;
1901     } else {
1902         $tables{'items'} = 1;
1903         $tables{'biblio'} = 1;
1904         $tables{'biblioitems'} = 1;
1905     }
1906
1907     # traverse through record
1908     MARCFIELD: foreach my $field ($record->fields()) {
1909         my $tag = $field->tag();
1910         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
1911         if ($field->is_control_field()) {
1912             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
1913             ENTRY: foreach my $entry (@{ $kohafields }) {
1914                 my ($subfield, $table, $column) = @{ $entry };
1915                 next ENTRY unless exists $tables{$table};
1916                 my $key = _disambiguate($table, $column);
1917                 if ($result->{$key}) {
1918                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($field->data() eq "")) {
1919                         $result->{$key} .= " | " . $field->data();
1920                     }
1921                 } else {
1922                     $result->{$key} = $field->data();
1923                 }
1924             }
1925         } else {
1926             # deal with subfields
1927             MARCSUBFIELD: foreach my $sf ($field->subfields()) {
1928                 my $code = $sf->[0];
1929                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
1930                 my $value = $sf->[1];
1931                 SFENTRY: foreach my $entry (@{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} }) {
1932                     my ($table, $column) = @{ $entry };
1933                     next SFENTRY unless exists $tables{$table};
1934                     my $key = _disambiguate($table, $column);
1935                     if ($result->{$key}) {
1936                         unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
1937                             $result->{$key} .= " | " . $value;
1938                         }
1939                     } else {
1940                         $result->{$key} = $value;
1941                     }
1942                 }
1943             }
1944         }
1945     }
1946
1947     # modify copyrightdate to keep only the 1st year found
1948     if (exists $result->{'copyrightdate'}) {
1949         my $temp = $result->{'copyrightdate'};
1950         $temp =~ m/c(\d\d\d\d)/;
1951         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
1952             $result->{'copyrightdate'} = $1;
1953         }
1954         else {                      # if no cYYYY, get the 1st date.
1955             $temp =~ m/(\d\d\d\d)/;
1956             $result->{'copyrightdate'} = $1;
1957         }
1958     }
1959
1960     # modify publicationyear to keep only the 1st year found
1961     if (exists $result->{'publicationyear'}) {
1962         my $temp = $result->{'publicationyear'};
1963         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
1964             $result->{'publicationyear'} = $1;
1965         }
1966         else {                      # if no cYYYY, get the 1st date.
1967             $temp =~ m/(\d\d\d\d)/;
1968             $result->{'publicationyear'} = $1;
1969         }
1970     }
1971
1972     return $result;
1973 }
1974
1975 sub _get_inverted_marc_field_map {
1976     my $field_map = {};
1977     my $relations = C4::Context->marcfromkohafield;
1978
1979     foreach my $frameworkcode (keys %{ $relations }) {
1980         foreach my $kohafield (keys %{ $relations->{$frameworkcode} }) {
1981             next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
1982             my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
1983             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
1984             my ($table, $column) = split /[.]/, $kohafield, 2;
1985             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
1986             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
1987         }
1988     }
1989     return $field_map;
1990 }
1991
1992 =head2 _disambiguate
1993
1994 =over 4
1995
1996 $newkey = _disambiguate($table, $field);
1997
1998 This is a temporary hack to distinguish between the
1999 following sets of columns when using TransformMarcToKoha.
2000
2001 items.cn_source & biblioitems.cn_source
2002 items.cn_sort & biblioitems.cn_sort
2003
2004 Columns that are currently NOT distinguished (FIXME
2005 due to lack of time to fully test) are:
2006
2007 biblio.notes and biblioitems.notes
2008 biblionumber
2009 timestamp
2010 biblioitemnumber
2011
2012 FIXME - this is necessary because prefixing each column
2013 name with the table name would require changing lots
2014 of code and templates, and exposing more of the DB
2015 structure than is good to the UI templates, particularly
2016 since biblio and bibloitems may well merge in a future
2017 version.  In the future, it would also be good to
2018 separate DB access and UI presentation field names
2019 more.
2020
2021 =back
2022
2023 =cut
2024
2025 sub _disambiguate {
2026     my ($table, $column) = @_;
2027     if ($column eq "cn_sort" or $column eq "cn_source") {
2028         return $table . '.' . $column;
2029     } else {
2030         return $column;
2031     }
2032
2033 }
2034
2035 =head2 get_koha_field_from_marc
2036
2037 =over 4
2038
2039 $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2040
2041 Internal function to map data from the MARC record to a specific non-MARC field.
2042 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2043
2044 =back
2045
2046 =cut
2047
2048 sub get_koha_field_from_marc {
2049     my ($koha_table,$koha_column,$record,$frameworkcode) = @_;
2050     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table.'.'.$koha_column, $frameworkcode );
2051     my $kohafield;
2052     foreach my $field ( $record->field($tagfield) ) {
2053         if ( $field->tag() < 10 ) {
2054             if ( $kohafield ) {
2055                 $kohafield .= " | " . $field->data();
2056             }
2057             else {
2058                 $kohafield = $field->data();
2059             }
2060         }
2061         else {
2062             if ( $field->subfields ) {
2063                 my @subfields = $field->subfields();
2064                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2065                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2066                         if ( $kohafield ) {
2067                             $kohafield .=
2068                               " | " . $subfields[$subfieldcount][1];
2069                         }
2070                         else {
2071                             $kohafield =
2072                               $subfields[$subfieldcount][1];
2073                         }
2074                     }
2075                 }
2076             }
2077         }
2078     }
2079     return $kohafield;
2080 }
2081
2082
2083 =head2 TransformMarcToKohaOneField
2084
2085 =over 4
2086
2087 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2088
2089 =back
2090
2091 =cut
2092
2093 sub TransformMarcToKohaOneField {
2094
2095     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2096     # only the 1st will be retrieved...
2097     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2098     my $res = "";
2099     my ( $tagfield, $subfield ) =
2100       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2101         $frameworkcode );
2102     foreach my $field ( $record->field($tagfield) ) {
2103         if ( $field->tag() < 10 ) {
2104             if ( $result->{$kohafield} ) {
2105                 $result->{$kohafield} .= " | " . $field->data();
2106             }
2107             else {
2108                 $result->{$kohafield} = $field->data();
2109             }
2110         }
2111         else {
2112             if ( $field->subfields ) {
2113                 my @subfields = $field->subfields();
2114                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2115                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2116                         if ( $result->{$kohafield} ) {
2117                             $result->{$kohafield} .=
2118                               " | " . $subfields[$subfieldcount][1];
2119                         }
2120                         else {
2121                             $result->{$kohafield} =
2122                               $subfields[$subfieldcount][1];
2123                         }
2124                     }
2125                 }
2126             }
2127         }
2128     }
2129     return $result;
2130 }
2131
2132 =head1  OTHER FUNCTIONS
2133
2134
2135 =head2 PrepareItemrecordDisplay
2136
2137 =over 4
2138
2139 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2140
2141 Returns a hash with all the fields for Display a given item data in a template
2142
2143 =back
2144
2145 =cut
2146
2147 sub PrepareItemrecordDisplay {
2148
2149     my ( $bibnum, $itemnum, $defaultvalues ) = @_;
2150
2151     my $dbh = C4::Context->dbh;
2152     my $frameworkcode = &GetFrameworkCode( $bibnum );
2153     my ( $itemtagfield, $itemtagsubfield ) =
2154       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2155     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2156     my $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2157     my @loop_data;
2158     my $authorised_values_sth =
2159       $dbh->prepare(
2160 "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib"
2161       );
2162     foreach my $tag ( sort keys %{$tagslib} ) {
2163         my $previous_tag = '';
2164         if ( $tag ne '' ) {
2165             # loop through each subfield
2166             my $cntsubf;
2167             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2168                 next if ( subfield_is_koha_internal_p($subfield) );
2169                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2170                 my %subfield_data;
2171                 $subfield_data{tag}           = $tag;
2172                 $subfield_data{subfield}      = $subfield;
2173                 $subfield_data{countsubfield} = $cntsubf++;
2174                 $subfield_data{kohafield}     =
2175                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2176
2177          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2178                 $subfield_data{marc_lib} = $tagslib->{$tag}->{$subfield}->{lib};
2179                 $subfield_data{mandatory} =
2180                   $tagslib->{$tag}->{$subfield}->{mandatory};
2181                 $subfield_data{repeatable} =
2182                   $tagslib->{$tag}->{$subfield}->{repeatable};
2183                 $subfield_data{hidden} = "display:none"
2184                   if $tagslib->{$tag}->{$subfield}->{hidden};
2185                 my ( $x, $value );
2186                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2187                   if ($itemrecord);
2188                 $value =~ s/"/&quot;/g;
2189
2190                 # search for itemcallnumber if applicable
2191                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2192                     'items.itemcallnumber'
2193                     && C4::Context->preference('itemcallnumber') )
2194                 {
2195                     my $CNtag =
2196                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2197                     my $CNsubfield =
2198                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2199                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2200                     if ($temp) {
2201                         $value = $temp->subfield($CNsubfield);
2202                     }
2203                 }
2204                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2205                     'items.itemcallnumber'
2206                     && $defaultvalues->{'callnumber'} )
2207                 {
2208                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
2209                     unless ($temp) {
2210                         $value = $defaultvalues->{'callnumber'};
2211                     }
2212                 }
2213                 if ( ($tagslib->{$tag}->{$subfield}->{kohafield} eq
2214                     'items.holdingbranch' ||
2215                     $tagslib->{$tag}->{$subfield}->{kohafield} eq
2216                     'items.homebranch')
2217                     && $defaultvalues->{'branchcode'} )
2218                 {
2219                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
2220                     unless ($temp) {
2221                         $value = $defaultvalues->{branchcode};
2222                     }
2223                 }
2224                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2225                     my @authorised_values;
2226                     my %authorised_lib;
2227
2228                     # builds list, depending on authorised value...
2229                     #---- branch
2230                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2231                         "branches" )
2232                     {
2233                         if ( ( C4::Context->preference("IndependantBranches") )
2234                             && ( C4::Context->userenv->{flags} != 1 ) )
2235                         {
2236                             my $sth =
2237                               $dbh->prepare(
2238                                 "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname"
2239                               );
2240                             $sth->execute( C4::Context->userenv->{branch} );
2241                             push @authorised_values, ""
2242                               unless (
2243                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2244                             while ( my ( $branchcode, $branchname ) =
2245                                 $sth->fetchrow_array )
2246                             {
2247                                 push @authorised_values, $branchcode;
2248                                 $authorised_lib{$branchcode} = $branchname;
2249                             }
2250                         }
2251                         else {
2252                             my $sth =
2253                               $dbh->prepare(
2254                                 "SELECT branchcode,branchname FROM branches ORDER BY branchname"
2255                               );
2256                             $sth->execute;
2257                             push @authorised_values, ""
2258                               unless (
2259                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2260                             while ( my ( $branchcode, $branchname ) =
2261                                 $sth->fetchrow_array )
2262                             {
2263                                 push @authorised_values, $branchcode;
2264                                 $authorised_lib{$branchcode} = $branchname;
2265                             }
2266                         }
2267
2268                         #----- itemtypes
2269                     }
2270                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2271                         "itemtypes" )
2272                     {
2273                         my $sth =
2274                           $dbh->prepare(
2275                             "SELECT itemtype,description FROM itemtypes ORDER BY description"
2276                           );
2277                         $sth->execute;
2278                         push @authorised_values, ""
2279                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2280                         while ( my ( $itemtype, $description ) =
2281                             $sth->fetchrow_array )
2282                         {
2283                             push @authorised_values, $itemtype;
2284                             $authorised_lib{$itemtype} = $description;
2285                         }
2286
2287                         #---- "true" authorised value
2288                     }
2289                     else {
2290                         $authorised_values_sth->execute(
2291                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2292                         push @authorised_values, ""
2293                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2294                         while ( my ( $value, $lib ) =
2295                             $authorised_values_sth->fetchrow_array )
2296                         {
2297                             push @authorised_values, $value;
2298                             $authorised_lib{$value} = $lib;
2299                         }
2300                     }
2301                     $subfield_data{marc_value} = CGI::scrolling_list(
2302                         -name     => 'field_value',
2303                         -values   => \@authorised_values,
2304                         -default  => "$value",
2305                         -labels   => \%authorised_lib,
2306                         -size     => 1,
2307                         -tabindex => '',
2308                         -multiple => 0,
2309                     );
2310                 }
2311                 else {
2312                     $subfield_data{marc_value} =
2313 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=\"50\" maxlength=\"255\" />";
2314                 }
2315                 push( @loop_data, \%subfield_data );
2316             }
2317         }
2318     }
2319     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2320       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2321     return {
2322         'itemtagfield'    => $itemtagfield,
2323         'itemtagsubfield' => $itemtagsubfield,
2324         'itemnumber'      => $itemnumber,
2325         'iteminformation' => \@loop_data
2326     };
2327 }
2328 #"
2329
2330 #
2331 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2332 # at the same time
2333 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2334 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2335 # =head2 ModZebrafiles
2336 #
2337 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2338 #
2339 # =cut
2340 #
2341 # sub ModZebrafiles {
2342 #
2343 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2344 #
2345 #     my $op;
2346 #     my $zebradir =
2347 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2348 #     unless ( opendir( DIR, "$zebradir" ) ) {
2349 #         warn "$zebradir not found";
2350 #         return;
2351 #     }
2352 #     closedir DIR;
2353 #     my $filename = $zebradir . $biblionumber;
2354 #
2355 #     if ($record) {
2356 #         open( OUTPUT, ">", $filename . ".xml" );
2357 #         print OUTPUT $record;
2358 #         close OUTPUT;
2359 #     }
2360 # }
2361
2362 =head2 ModZebra
2363
2364 =over 4
2365
2366 ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2367
2368     $biblionumber is the biblionumber we want to index
2369     $op is specialUpdate or delete, and is used to know what we want to do
2370     $server is the server that we want to update
2371     $oldRecord is the MARC::Record containing the previous version of the record.  This is used only when
2372       NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2373       do an update.
2374     $newRecord is the MARC::Record containing the new record. It is usefull only when NoZebra=1, and is used to know what to add to the nozebra database. (the record in mySQL being, if it exist, the previous record, the one just before the modif. We need both : the previous and the new one.
2375
2376 =back
2377
2378 =cut
2379
2380 sub ModZebra {
2381 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2382     my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2383     my $dbh=C4::Context->dbh;
2384
2385     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2386     # at the same time
2387     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2388     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2389
2390     if (C4::Context->preference("NoZebra")) {
2391         # lock the nozebra table : we will read index lines, update them in Perl process
2392         # and write everything in 1 transaction.
2393         # lock the table to avoid someone else overwriting what we are doing
2394         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2395         my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2396         if ($op eq 'specialUpdate') {
2397             # OK, we have to add or update the record
2398             # 1st delete (virtually, in indexes), if record actually exists
2399             if ($oldRecord) {
2400                 %result = _DelBiblioNoZebra($biblionumber,$oldRecord,$server);
2401             }
2402             # ... add the record
2403             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
2404         } else {
2405             # it's a deletion, delete the record...
2406             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2407             %result=_DelBiblioNoZebra($biblionumber,$oldRecord,$server);
2408         }
2409         # ok, now update the database...
2410         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2411         foreach my $key (keys %result) {
2412             foreach my $index (keys %{$result{$key}}) {
2413                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
2414             }
2415         }
2416         $dbh->do('UNLOCK TABLES');
2417     } else {
2418         #
2419         # we use zebra, just fill zebraqueue table
2420         #
2421         my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2422                          WHERE server = ?
2423                          AND   biblio_auth_number = ?
2424                          AND   operation = ?
2425                          AND   done = 0";
2426         my $check_sth = $dbh->prepare_cached($check_sql);
2427         $check_sth->execute($server, $biblionumber, $op);
2428         my ($count) = $check_sth->fetchrow_array;
2429         $check_sth->finish();
2430         if ($count == 0) {
2431             my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2432             $sth->execute($biblionumber,$server,$op);
2433             $sth->finish;
2434         }
2435     }
2436 }
2437
2438 =head2 GetNoZebraIndexes
2439
2440     %indexes = GetNoZebraIndexes;
2441
2442     return the data from NoZebraIndexes syspref.
2443
2444 =cut
2445
2446 sub GetNoZebraIndexes {
2447     my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2448     my %indexes;
2449     INDEX: foreach my $line (split /['"],[\n\r]*/,$no_zebra_indexes) {
2450         $line =~ /(.*)=>(.*)/;
2451         my $index = $1; # initial ' or " is removed afterwards
2452         my $fields = $2;
2453         $index =~ s/'|"|\s//g;
2454         $fields =~ s/'|"|\s//g;
2455         $indexes{$index}=$fields;
2456     }
2457     return %indexes;
2458 }
2459
2460 =head1 INTERNAL FUNCTIONS
2461
2462 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2463
2464     function to delete a biblio in NoZebra indexes
2465     This function does NOT delete anything in database : it reads all the indexes entries
2466     that have to be deleted & delete them in the hash
2467     The SQL part is done either :
2468     - after the Add if we are modifying a biblio (delete + add again)
2469     - immediatly after this sub if we are doing a true deletion.
2470     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2471
2472 =cut
2473
2474
2475 sub _DelBiblioNoZebra {
2476     my ($biblionumber, $record, $server)=@_;
2477
2478     # Get the indexes
2479     my $dbh = C4::Context->dbh;
2480     # Get the indexes
2481     my %index;
2482     my $title;
2483     if ($server eq 'biblioserver') {
2484         %index=GetNoZebraIndexes;
2485         # get title of the record (to store the 10 first letters with the index)
2486         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title', ''); # FIXME: should be GetFrameworkCode($biblionumber) ??
2487         $title = lc($record->subfield($titletag,$titlesubfield));
2488     } else {
2489         # for authorities, the "title" is the $a mainentry
2490         my ($auth_type_tag, $auth_type_sf) = C4::AuthoritiesMarc::get_auth_type_location();
2491         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield($auth_type_tag, $auth_type_sf));
2492         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2493         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2494         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
2495         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
2496         $index{'auth_type'}    = "${auth_type_tag}${auth_type_sf}";
2497     }
2498
2499     my %result;
2500     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2501     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2502     # limit to 10 char, should be enough, and limit the DB size
2503     $title = substr($title,0,10);
2504     #parse each field
2505     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2506     foreach my $field ($record->fields()) {
2507         #parse each subfield
2508         next if $field->tag <10;
2509         foreach my $subfield ($field->subfields()) {
2510             my $tag = $field->tag();
2511             my $subfieldcode = $subfield->[0];
2512             my $indexed=0;
2513             # check each index to see if the subfield is stored somewhere
2514             # otherwise, store it in __RAW__ index
2515             foreach my $key (keys %index) {
2516 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2517                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2518                     $indexed=1;
2519                     my $line= lc $subfield->[1];
2520                     # remove meaningless value in the field...
2521                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2522                     # ... and split in words
2523                     foreach (split / /,$line) {
2524                         next unless $_; # skip  empty values (multiple spaces)
2525                         # if the entry is already here, do nothing, the biblionumber has already be removed
2526                         unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) ) {
2527                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2528                             $sth2->execute($server,$key,$_);
2529                             my $existing_biblionumbers = $sth2->fetchrow;
2530                             # it exists
2531                             if ($existing_biblionumbers) {
2532 #                                 warn " existing for $key $_: $existing_biblionumbers";
2533                                 $result{$key}->{$_} =$existing_biblionumbers;
2534                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2535                             }
2536                         }
2537                     }
2538                 }
2539             }
2540             # the subfield is not indexed, store it in __RAW__ index anyway
2541             unless ($indexed) {
2542                 my $line= lc $subfield->[1];
2543                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2544                 # ... and split in words
2545                 foreach (split / /,$line) {
2546                     next unless $_; # skip  empty values (multiple spaces)
2547                     # if the entry is already here, do nothing, the biblionumber has already be removed
2548                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2549                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2550                         $sth2->execute($server,'__RAW__',$_);
2551                         my $existing_biblionumbers = $sth2->fetchrow;
2552                         # it exists
2553                         if ($existing_biblionumbers) {
2554                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
2555                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2556                         }
2557                     }
2558                 }
2559             }
2560         }
2561     }
2562     return %result;
2563 }
2564
2565 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2566
2567     function to add a biblio in NoZebra indexes
2568
2569 =cut
2570
2571 sub _AddBiblioNoZebra {
2572     my ($biblionumber, $record, $server, %result)=@_;
2573     my $dbh = C4::Context->dbh;
2574     # Get the indexes
2575     my %index;
2576     my $title;
2577     if ($server eq 'biblioserver') {
2578         %index=GetNoZebraIndexes;
2579         # get title of the record (to store the 10 first letters with the index)
2580         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title', ''); # FIXME: should be GetFrameworkCode($biblionumber) ??
2581         $title = lc($record->subfield($titletag,$titlesubfield));
2582     } else {
2583         # warn "server : $server";
2584         # for authorities, the "title" is the $a mainentry
2585         my ($auth_type_tag, $auth_type_sf) = C4::AuthoritiesMarc::get_auth_type_location();
2586         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield($auth_type_tag, $auth_type_sf));
2587         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2588         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2589         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
2590         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
2591         $index{'auth_type'}    = "${auth_type_tag}${auth_type_sf}";
2592     }
2593
2594     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2595     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
2596     # limit to 10 char, should be enough, and limit the DB size
2597     $title = substr($title,0,10);
2598     #parse each field
2599     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2600     foreach my $field ($record->fields()) {
2601         #parse each subfield
2602         ###FIXME: impossible to index a 001-009 value with NoZebra
2603         next if $field->tag <10;
2604         foreach my $subfield ($field->subfields()) {
2605             my $tag = $field->tag();
2606             my $subfieldcode = $subfield->[0];
2607             my $indexed=0;
2608 #             warn "INDEXING :".$subfield->[1];
2609             # check each index to see if the subfield is stored somewhere
2610             # otherwise, store it in __RAW__ index
2611             foreach my $key (keys %index) {
2612 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2613                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2614                     $indexed=1;
2615                     my $line= lc $subfield->[1];
2616                     # remove meaningless value in the field...
2617                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2618                     # ... and split in words
2619                     foreach (split / /,$line) {
2620                         next unless $_; # skip  empty values (multiple spaces)
2621                         # if the entry is already here, improve weight
2622 #                         warn "managing $_";
2623                         if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/) {
2624                             my $weight = $1 + 1;
2625                             $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2626                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2627                         } else {
2628                             # get the value if it exist in the nozebra table, otherwise, create it
2629                             $sth2->execute($server,$key,$_);
2630                             my $existing_biblionumbers = $sth2->fetchrow;
2631                             # it exists
2632                             if ($existing_biblionumbers) {
2633                                 $result{$key}->{"$_"} =$existing_biblionumbers;
2634                                 my $weight = defined $1 ? $1 + 1 : 1;
2635                                 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2636                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2637                             # create a new ligne for this entry
2638                             } else {
2639 #                             warn "INSERT : $server / $key / $_";
2640                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
2641                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
2642                             }
2643                         }
2644                     }
2645                 }
2646             }
2647             # the subfield is not indexed, store it in __RAW__ index anyway
2648             unless ($indexed) {
2649                 my $line= lc $subfield->[1];
2650                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2651                 # ... and split in words
2652                 foreach (split / /,$line) {
2653                     next unless $_; # skip  empty values (multiple spaces)
2654                     # if the entry is already here, improve weight
2655                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/) {
2656                         my $weight=$1+1;
2657                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2658                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2659                     } else {
2660                         # get the value if it exist in the nozebra table, otherwise, create it
2661                         $sth2->execute($server,'__RAW__',$_);
2662                         my $existing_biblionumbers = $sth2->fetchrow;
2663                         # it exists
2664                         if ($existing_biblionumbers) {
2665                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
2666                             my $weight=$1+1;
2667                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2668                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2669                         # create a new ligne for this entry
2670                         } else {
2671                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
2672                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
2673                         }
2674                     }
2675                 }
2676             }
2677         }
2678     }
2679     return %result;
2680 }
2681
2682
2683 =head2 _find_value
2684
2685 =over 4
2686
2687 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2688
2689 Find the given $subfield in the given $tag in the given
2690 MARC::Record $record.  If the subfield is found, returns
2691 the (indicators, value) pair; otherwise, (undef, undef) is
2692 returned.
2693
2694 PROPOSITION :
2695 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2696 I suggest we export it from this module.
2697
2698 =back
2699
2700 =cut
2701
2702 sub _find_value {
2703     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2704     my @result;
2705     my $indicator;
2706     if ( $tagfield < 10 ) {
2707         if ( $record->field($tagfield) ) {
2708             push @result, $record->field($tagfield)->data();
2709         }
2710         else {
2711             push @result, "";
2712         }
2713     }
2714     else {
2715         foreach my $field ( $record->field($tagfield) ) {
2716             my @subfields = $field->subfields();
2717             foreach my $subfield (@subfields) {
2718                 if ( @$subfield[0] eq $insubfield ) {
2719                     push @result, @$subfield[1];
2720                     $indicator = $field->indicator(1) . $field->indicator(2);
2721                 }
2722             }
2723         }
2724     }
2725     return ( $indicator, @result );
2726 }
2727
2728 =head2 _koha_marc_update_bib_ids
2729
2730 =over 4
2731
2732 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2733
2734 Internal function to add or update biblionumber and biblioitemnumber to
2735 the MARC XML.
2736
2737 =back
2738
2739 =cut
2740
2741 sub _koha_marc_update_bib_ids {
2742     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
2743
2744     # we must add bibnum and bibitemnum in MARC::Record...
2745     # we build the new field with biblionumber and biblioitemnumber
2746     # we drop the original field
2747     # we add the new builded field.
2748     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
2749     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
2750
2751     if ($biblio_tag != $biblioitem_tag) {
2752         # biblionumber & biblioitemnumber are in different fields
2753
2754         # deal with biblionumber
2755         my ($new_field, $old_field);
2756         if ($biblio_tag < 10) {
2757             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
2758         } else {
2759             $new_field =
2760               MARC::Field->new( $biblio_tag, '', '',
2761                 "$biblio_subfield" => $biblionumber );
2762         }
2763
2764         # drop old field and create new one...
2765         $old_field = $record->field($biblio_tag);
2766         $record->delete_field($old_field) if $old_field;
2767         $record->append_fields($new_field);
2768
2769         # deal with biblioitemnumber
2770         if ($biblioitem_tag < 10) {
2771             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
2772         } else {
2773             $new_field =
2774               MARC::Field->new( $biblioitem_tag, '', '',
2775                 "$biblioitem_subfield" => $biblioitemnumber, );
2776         }
2777         # drop old field and create new one...
2778         $old_field = $record->field($biblioitem_tag);
2779         $record->delete_field($old_field) if $old_field;
2780         $record->insert_fields_ordered($new_field);
2781
2782     } else {
2783         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
2784         my $new_field = MARC::Field->new(
2785             $biblio_tag, '', '',
2786             "$biblio_subfield" => $biblionumber,
2787             "$biblioitem_subfield" => $biblioitemnumber
2788         );
2789
2790         # drop old field and create new one...
2791         my $old_field = $record->field($biblio_tag);
2792         $record->delete_field($old_field) if $old_field;
2793         $record->insert_fields_ordered($new_field);
2794     }
2795 }
2796
2797 =head2 _koha_marc_update_biblioitem_cn_sort
2798
2799 =over 4
2800
2801 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2802
2803 =back
2804
2805 Given a MARC bib record and the biblioitem hash, update the
2806 subfield that contains a copy of the value of biblioitems.cn_sort.
2807
2808 =cut
2809
2810 sub _koha_marc_update_biblioitem_cn_sort {
2811     my $marc = shift;
2812     my $biblioitem = shift;
2813     my $frameworkcode= shift;
2814
2815     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.cn_sort",$frameworkcode);
2816     return unless $biblioitem_tag;
2817
2818     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2819
2820     if (my $field = $marc->field($biblioitem_tag)) {
2821         $field->delete_subfield(code => $biblioitem_subfield);
2822         if ($cn_sort ne '') {
2823             $field->add_subfields($biblioitem_subfield => $cn_sort);
2824         }
2825     } else {
2826         # if we get here, no biblioitem tag is present in the MARC record, so
2827         # we'll create it if $cn_sort is not empty -- this would be
2828         # an odd combination of events, however
2829         if ($cn_sort) {
2830             $marc->insert_grouped_field(MARC::Field->new($biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort));
2831         }
2832     }
2833 }
2834
2835 =head2 _koha_add_biblio
2836
2837 =over 4
2838
2839 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2840
2841 Internal function to add a biblio ($biblio is a hash with the values)
2842
2843 =back
2844
2845 =cut
2846
2847 sub _koha_add_biblio {
2848     my ( $dbh, $biblio, $frameworkcode ) = @_;
2849
2850     my $error;
2851
2852     # set the series flag
2853     my $serial = 0;
2854     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
2855
2856     my $query =
2857         "INSERT INTO biblio
2858         SET frameworkcode = ?,
2859             author = ?,
2860             title = ?,
2861             unititle =?,
2862             notes = ?,
2863             serial = ?,
2864             seriestitle = ?,
2865             copyrightdate = ?,
2866             datecreated=NOW(),
2867             abstract = ?
2868         ";
2869     my $sth = $dbh->prepare($query);
2870     $sth->execute(
2871         $frameworkcode,
2872         $biblio->{'author'},
2873         $biblio->{'title'},
2874         $biblio->{'unititle'},
2875         $biblio->{'notes'},
2876         $serial,
2877         $biblio->{'seriestitle'},
2878         $biblio->{'copyrightdate'},
2879         $biblio->{'abstract'}
2880     );
2881
2882     my $biblionumber = $dbh->{'mysql_insertid'};
2883     if ( $dbh->errstr ) {
2884         $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
2885         warn $error;
2886     }
2887
2888     $sth->finish();
2889     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2890     return ($biblionumber,$error);
2891 }
2892
2893 =head2 _koha_modify_biblio
2894
2895 =over 4
2896
2897 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2898
2899 Internal function for updating the biblio table
2900
2901 =back
2902
2903 =cut
2904
2905 sub _koha_modify_biblio {
2906     my ( $dbh, $biblio, $frameworkcode ) = @_;
2907     my $error;
2908
2909     my $query = "
2910         UPDATE biblio
2911         SET    frameworkcode = ?,
2912                author = ?,
2913                title = ?,
2914                unititle = ?,
2915                notes = ?,
2916                serial = ?,
2917                seriestitle = ?,
2918                copyrightdate = ?,
2919                abstract = ?
2920         WHERE  biblionumber = ?
2921         "
2922     ;
2923     my $sth = $dbh->prepare($query);
2924
2925     $sth->execute(
2926         $frameworkcode,
2927         $biblio->{'author'},
2928         $biblio->{'title'},
2929         $biblio->{'unititle'},
2930         $biblio->{'notes'},
2931         $biblio->{'serial'},
2932         $biblio->{'seriestitle'},
2933         $biblio->{'copyrightdate'},
2934         $biblio->{'abstract'},
2935         $biblio->{'biblionumber'}
2936     ) if $biblio->{'biblionumber'};
2937
2938     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2939         $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
2940         warn $error;
2941     }
2942     return ( $biblio->{'biblionumber'},$error );
2943 }
2944
2945 =head2 _koha_modify_biblioitem_nonmarc
2946
2947 =over 4
2948
2949 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2950
2951 Updates biblioitems row except for marc and marcxml, which should be changed
2952 via ModBiblioMarc
2953
2954 =back
2955
2956 =cut
2957
2958 sub _koha_modify_biblioitem_nonmarc {
2959     my ( $dbh, $biblioitem ) = @_;
2960     my $error;
2961
2962     # re-calculate the cn_sort, it may have changed
2963     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2964
2965     my $query =
2966     "UPDATE biblioitems
2967     SET biblionumber    = ?,
2968         volume          = ?,
2969         number          = ?,
2970         itemtype        = ?,
2971         isbn            = ?,
2972         issn            = ?,
2973         publicationyear = ?,
2974         publishercode   = ?,
2975         volumedate      = ?,
2976         volumedesc      = ?,
2977         collectiontitle = ?,
2978         collectionissn  = ?,
2979         collectionvolume= ?,
2980         editionstatement= ?,
2981         editionresponsibility = ?,
2982         illus           = ?,
2983         pages           = ?,
2984         notes           = ?,
2985         size            = ?,
2986         place           = ?,
2987         lccn            = ?,
2988         url             = ?,
2989         cn_source       = ?,
2990         cn_class        = ?,
2991         cn_item         = ?,
2992         cn_suffix       = ?,
2993         cn_sort         = ?,
2994         totalissues     = ?
2995         where biblioitemnumber = ?
2996         ";
2997     my $sth = $dbh->prepare($query);
2998     $sth->execute(
2999         $biblioitem->{'biblionumber'},
3000         $biblioitem->{'volume'},
3001         $biblioitem->{'number'},
3002         $biblioitem->{'itemtype'},
3003         $biblioitem->{'isbn'},
3004         $biblioitem->{'issn'},
3005         $biblioitem->{'publicationyear'},
3006         $biblioitem->{'publishercode'},
3007         $biblioitem->{'volumedate'},
3008         $biblioitem->{'volumedesc'},
3009         $biblioitem->{'collectiontitle'},
3010         $biblioitem->{'collectionissn'},
3011         $biblioitem->{'collectionvolume'},
3012         $biblioitem->{'editionstatement'},
3013         $biblioitem->{'editionresponsibility'},
3014         $biblioitem->{'illus'},
3015         $biblioitem->{'pages'},
3016         $biblioitem->{'bnotes'},
3017         $biblioitem->{'size'},
3018         $biblioitem->{'place'},
3019         $biblioitem->{'lccn'},
3020         $biblioitem->{'url'},
3021         $biblioitem->{'biblioitems.cn_source'},
3022         $biblioitem->{'cn_class'},
3023         $biblioitem->{'cn_item'},
3024         $biblioitem->{'cn_suffix'},
3025         $cn_sort,
3026         $biblioitem->{'totalissues'},
3027         $biblioitem->{'biblioitemnumber'}
3028     );
3029     if ( $dbh->errstr ) {
3030         $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
3031         warn $error;
3032     }
3033     return ($biblioitem->{'biblioitemnumber'},$error);
3034 }
3035
3036 =head2 _koha_add_biblioitem
3037
3038 =over 4
3039
3040 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3041
3042 Internal function to add a biblioitem
3043
3044 =back
3045
3046 =cut
3047
3048 sub _koha_add_biblioitem {
3049     my ( $dbh, $biblioitem ) = @_;
3050     my $error;
3051
3052     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3053     my $query =
3054     "INSERT INTO biblioitems SET
3055         biblionumber    = ?,
3056         volume          = ?,
3057         number          = ?,
3058         itemtype        = ?,
3059         isbn            = ?,
3060         issn            = ?,
3061         publicationyear = ?,
3062         publishercode   = ?,
3063         volumedate      = ?,
3064         volumedesc      = ?,
3065         collectiontitle = ?,
3066         collectionissn  = ?,
3067         collectionvolume= ?,
3068         editionstatement= ?,
3069         editionresponsibility = ?,
3070         illus           = ?,
3071         pages           = ?,
3072         notes           = ?,
3073         size            = ?,
3074         place           = ?,
3075         lccn            = ?,
3076         marc            = ?,
3077         url             = ?,
3078         cn_source       = ?,
3079         cn_class        = ?,
3080         cn_item         = ?,
3081         cn_suffix       = ?,
3082         cn_sort         = ?,
3083         totalissues     = ?
3084         ";
3085     my $sth = $dbh->prepare($query);
3086     $sth->execute(
3087         $biblioitem->{'biblionumber'},
3088         $biblioitem->{'volume'},
3089         $biblioitem->{'number'},
3090         $biblioitem->{'itemtype'},
3091         $biblioitem->{'isbn'},
3092         $biblioitem->{'issn'},
3093         $biblioitem->{'publicationyear'},
3094         $biblioitem->{'publishercode'},
3095         $biblioitem->{'volumedate'},
3096         $biblioitem->{'volumedesc'},
3097         $biblioitem->{'collectiontitle'},
3098         $biblioitem->{'collectionissn'},
3099         $biblioitem->{'collectionvolume'},
3100         $biblioitem->{'editionstatement'},
3101         $biblioitem->{'editionresponsibility'},
3102         $biblioitem->{'illus'},
3103         $biblioitem->{'pages'},
3104         $biblioitem->{'bnotes'},
3105         $biblioitem->{'size'},
3106         $biblioitem->{'place'},
3107         $biblioitem->{'lccn'},
3108         $biblioitem->{'marc'},
3109         $biblioitem->{'url'},
3110         $biblioitem->{'biblioitems.cn_source'},
3111         $biblioitem->{'cn_class'},
3112         $biblioitem->{'cn_item'},
3113         $biblioitem->{'cn_suffix'},
3114         $cn_sort,
3115         $biblioitem->{'totalissues'}
3116     );
3117     my $bibitemnum = $dbh->{'mysql_insertid'};
3118     if ( $dbh->errstr ) {
3119         $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
3120         warn $error;
3121     }
3122     $sth->finish();
3123     return ($bibitemnum,$error);
3124 }
3125
3126 =head2 _koha_delete_biblio
3127
3128 =over 4
3129
3130 $error = _koha_delete_biblio($dbh,$biblionumber);
3131
3132 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3133
3134 C<$dbh> - the database handle
3135 C<$biblionumber> - the biblionumber of the biblio to be deleted
3136
3137 =back
3138
3139 =cut
3140
3141 # FIXME: add error handling
3142
3143 sub _koha_delete_biblio {
3144     my ( $dbh, $biblionumber ) = @_;
3145
3146     # get all the data for this biblio
3147     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3148     $sth->execute($biblionumber);
3149
3150     if ( my $data = $sth->fetchrow_hashref ) {
3151
3152         # save the record in deletedbiblio
3153         # find the fields to save
3154         my $query = "INSERT INTO deletedbiblio SET ";
3155         my @bind  = ();
3156         foreach my $temp ( keys %$data ) {
3157             $query .= "$temp = ?,";
3158             push( @bind, $data->{$temp} );
3159         }
3160
3161         # replace the last , by ",?)"
3162         $query =~ s/\,$//;
3163         my $bkup_sth = $dbh->prepare($query);
3164         $bkup_sth->execute(@bind);
3165         $bkup_sth->finish;
3166
3167         # delete the biblio
3168         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3169         $del_sth->execute($biblionumber);
3170         $del_sth->finish;
3171     }
3172     $sth->finish;
3173     return undef;
3174 }
3175
3176 =head2 _koha_delete_biblioitems
3177
3178 =over 4
3179
3180 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3181
3182 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3183
3184 C<$dbh> - the database handle
3185 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3186
3187 =back
3188
3189 =cut
3190
3191 # FIXME: add error handling
3192
3193 sub _koha_delete_biblioitems {
3194     my ( $dbh, $biblioitemnumber ) = @_;
3195
3196     # get all the data for this biblioitem
3197     my $sth =
3198       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3199     $sth->execute($biblioitemnumber);
3200
3201     if ( my $data = $sth->fetchrow_hashref ) {
3202
3203         # save the record in deletedbiblioitems
3204         # find the fields to save
3205         my $query = "INSERT INTO deletedbiblioitems SET ";
3206         my @bind  = ();
3207         foreach my $temp ( keys %$data ) {
3208             $query .= "$temp = ?,";
3209             push( @bind, $data->{$temp} );
3210         }
3211
3212         # replace the last , by ",?)"
3213         $query =~ s/\,$//;
3214         my $bkup_sth = $dbh->prepare($query);
3215         $bkup_sth->execute(@bind);
3216         $bkup_sth->finish;
3217
3218         # delete the biblioitem
3219         my $del_sth =
3220           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3221         $del_sth->execute($biblioitemnumber);
3222         $del_sth->finish;
3223     }
3224     $sth->finish;
3225     return undef;
3226 }
3227
3228 =head1 UNEXPORTED FUNCTIONS
3229
3230 =head2 ModBiblioMarc
3231
3232     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3233
3234     Add MARC data for a biblio to koha
3235
3236     Function exported, but should NOT be used, unless you really know what you're doing
3237
3238 =cut
3239
3240 sub ModBiblioMarc {
3241
3242 # pass the MARC::Record to this function, and it will create the records in the marc field
3243     my ( $record, $biblionumber, $frameworkcode ) = @_;
3244     my $dbh = C4::Context->dbh;
3245     my @fields = $record->fields();
3246     if ( !$frameworkcode ) {
3247         $frameworkcode = "";
3248     }
3249     my $sth =
3250       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3251     $sth->execute( $frameworkcode, $biblionumber );
3252     $sth->finish;
3253     my $encoding = C4::Context->preference("marcflavour");
3254
3255     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3256     if ( $encoding eq "UNIMARC" ) {
3257         my $string;
3258         if ( length($record->subfield( 100, "a" )) == 35 ) {
3259             $string = $record->subfield( 100, "a" );
3260             my $f100 = $record->field(100);
3261             $record->delete_field($f100);
3262         }
3263         else {
3264             $string = POSIX::strftime( "%Y%m%d", localtime );
3265             $string =~ s/\-//g;
3266             $string = sprintf( "%-*s", 35, $string );
3267         }
3268         substr( $string, 22, 6, "frey50" );
3269         unless ( $record->subfield( 100, "a" ) ) {
3270             $record->insert_grouped_field(
3271                 MARC::Field->new( 100, "", "", "a" => $string ) );
3272         }
3273     }
3274     my $oldRecord;
3275     if (C4::Context->preference("NoZebra")) {
3276         # only NoZebra indexing needs to have
3277         # the previous version of the record
3278         $oldRecord = GetMarcBiblio($biblionumber);
3279     }
3280     $sth =
3281       $dbh->prepare(
3282         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3283     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
3284         $biblionumber );
3285     $sth->finish;
3286     ModZebra($biblionumber,"specialUpdate","biblioserver",$oldRecord,$record);
3287     return $biblionumber;
3288 }
3289
3290 =head2 z3950_extended_services
3291
3292 z3950_extended_services($serviceType,$serviceOptions,$record);
3293
3294     z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
3295
3296 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3297
3298 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3299
3300     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3301
3302 and maybe
3303
3304     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3305     syntax => the record syntax (transfer syntax)
3306     databaseName = Database from connection object
3307
3308     To set serviceOptions, call set_service_options($serviceType)
3309
3310 C<$record> the record, if one is needed for the service type
3311
3312     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3313
3314 =cut
3315
3316 sub z3950_extended_services {
3317     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3318
3319     # get our connection object
3320     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3321
3322     # create a new package object
3323     my $Zpackage = $Zconn->package();
3324
3325     # set our options
3326     $Zpackage->option( action => $action );
3327
3328     if ( $serviceOptions->{'databaseName'} ) {
3329         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3330     }
3331     if ( $serviceOptions->{'recordIdNumber'} ) {
3332         $Zpackage->option(
3333             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3334     }
3335     if ( $serviceOptions->{'recordIdOpaque'} ) {
3336         $Zpackage->option(
3337             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3338     }
3339
3340  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3341  #if ($serviceType eq 'itemorder') {
3342  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3343  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3344  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3345  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3346  #}
3347
3348     if ( $serviceOptions->{record} ) {
3349         $Zpackage->option( record => $serviceOptions->{record} );
3350
3351         # can be xml or marc
3352         if ( $serviceOptions->{'syntax'} ) {
3353             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3354         }
3355     }
3356
3357     # send the request, handle any exception encountered
3358     eval { $Zpackage->send($serviceType) };
3359     if ( $@ && $@->isa("ZOOM::Exception") ) {
3360         return "error:  " . $@->code() . " " . $@->message() . "\n";
3361     }
3362
3363     # free up package resources
3364     $Zpackage->destroy();
3365 }
3366
3367 =head2 set_service_options
3368
3369 my $serviceOptions = set_service_options($serviceType);
3370
3371 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3372
3373 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3374
3375 =cut
3376
3377 sub set_service_options {
3378     my ($serviceType) = @_;
3379     my $serviceOptions;
3380
3381 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3382 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3383
3384     if ( $serviceType eq 'commit' ) {
3385
3386         # nothing to do
3387     }
3388     if ( $serviceType eq 'create' ) {
3389
3390         # nothing to do
3391     }
3392     if ( $serviceType eq 'drop' ) {
3393         die "ERROR: 'drop' not currently supported (by Zebra)";
3394     }
3395     return $serviceOptions;
3396 }
3397
3398 =head3 get_biblio_authorised_values
3399
3400   find the types and values for all authorised values assigned to this biblio.
3401
3402   parameters:
3403     biblionumber
3404     MARC::Record of the bib
3405
3406   returns: a hashref malling the authorised value to the value set for this biblionumber
3407
3408       $authorised_values = {
3409                              'Scent'     => 'flowery',
3410                              'Audience'  => 'Young Adult',
3411                              'itemtypes' => 'SER',
3412                            };
3413
3414   Notes: forlibrarian should probably be passed in, and called something different.
3415
3416
3417 =cut
3418
3419 sub get_biblio_authorised_values {
3420     my $biblionumber = shift;
3421     my $record       = shift;
3422
3423     my $forlibrarian = 1; # are we in staff or opac?
3424     my $frameworkcode = GetFrameworkCode( $biblionumber );
3425
3426     my $authorised_values;
3427
3428     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3429       or return $authorised_values;
3430
3431     # assume that these entries in the authorised_value table are bibliolevel.
3432     # ones that start with 'item%' are item level.
3433     my $query = q(SELECT distinct authorised_value, kohafield
3434                     FROM marc_subfield_structure
3435                     WHERE authorised_value !=''
3436                       AND (kohafield like 'biblio%'
3437                        OR  kohafield like '') );
3438     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3439
3440     foreach my $tag ( keys( %$tagslib ) ) {
3441         foreach my $subfield ( keys( %{$tagslib->{ $tag }} ) ) {
3442             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3443             if ( 'HASH' eq ref $tagslib->{ $tag }{ $subfield } ) {
3444                 if ( defined $tagslib->{ $tag }{ $subfield }{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } ) {
3445                     if ( defined $record->field( $tag ) ) {
3446                         my $this_subfield_value = $record->field( $tag )->subfield( $subfield );
3447                         if ( defined $this_subfield_value ) {
3448                             $authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } = $this_subfield_value;
3449                         }
3450                     }
3451                 }
3452             }
3453         }
3454     }
3455     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3456     return $authorised_values;
3457 }
3458
3459
3460 1;
3461
3462 __END__
3463
3464 =head1 AUTHOR
3465
3466 Koha Developement team <info@koha.org>
3467
3468 Paul POULAIN paul.poulain@free.fr
3469
3470 Joshua Ferraro jmf@liblime.com
3471
3472 =cut