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