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
1130     my @marcurls;
1131     for my $field ( $record->field('856') ) {
1132         my $marcurl;
1133         my @notes;
1134         for my $note ( $field->subfield('z') ) {
1135             push @notes, { note => $note };
1136         }
1137         my @urls = $field->subfield('u');
1138         foreach my $url (@urls) {
1139             if ( $marcflavour eq 'MARC21' ) {
1140                 my $s3   = $field->subfield('3');
1141                 my $link = $field->subfield('y');
1142                 unless ( $url =~ /^\w+:/ ) {
1143                     if ( $field->indicator(1) eq '7' ) {
1144                         $url = $field->subfield('2') . "://" . $url;
1145                     } elsif ( $field->indicator(1) eq '1' ) {
1146                         $url = 'ftp://' . $url;
1147                     } else {
1148                         #  properly, this should be if ind1=4,
1149                         #  however we will assume http protocol since we're building a link.
1150                         $url = 'http://' . $url;
1151                     }
1152                 }
1153                 # TODO handle ind 2 (relationship)
1154                 $marcurl = {
1155                     MARCURL => $url,
1156                     notes   => \@notes,
1157                 };
1158                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1159                 $marcurl->{'part'} = $s3 if ($link);
1160                 $marcurl->{'toc'} = 1 if ( $s3 =~ /^[Tt]able/ );
1161             } else {
1162                 $marcurl->{'linktext'} = $field->subfield('z') || C4::Context->preference('URLLinkText') || $url;
1163                 $marcurl->{'MARCURL'} = $url;
1164             }
1165             push @marcurls, $marcurl;
1166         }
1167     }
1168     return \@marcurls;
1169 }
1170
1171 =head2 GetMarcSeries
1172
1173 =over 4
1174
1175 $marcseriesarray = GetMarcSeries($record,$marcflavour);
1176 Get all series from the MARC record and returns them in an array.
1177 The series are stored in differents places depending on MARC flavour
1178
1179 =back
1180
1181 =cut
1182
1183 sub GetMarcSeries {
1184     my ($record, $marcflavour) = @_;
1185     my ($mintag, $maxtag);
1186     if ($marcflavour eq "MARC21") {
1187         $mintag = "440";
1188         $maxtag = "490";
1189     } else {           # assume unimarc if not marc21
1190         $mintag = "600";
1191         $maxtag = "619";
1192     }
1193
1194     my @marcseries;
1195     my $subjct = "";
1196     my $subfield = "";
1197     my $marcsubjct;
1198
1199     foreach my $field ($record->field('440'), $record->field('490')) {
1200         my @subfields_loop;
1201         #my $value = $field->subfield('a');
1202         #$marcsubjct = {MARCSUBJCT => $value,};
1203         my @subfields = $field->subfields();
1204         #warn "subfields:".join " ", @$subfields;
1205         my $counter = 0;
1206         my @link_loop;
1207         for my $series_subfield (@subfields) {
1208             my $volume_number;
1209             undef $volume_number;
1210             # see if this is an instance of a volume
1211             if ($series_subfield->[0] eq 'v') {
1212                 $volume_number=1;
1213             }
1214
1215             my $code = $series_subfield->[0];
1216             my $value = $series_subfield->[1];
1217             my $linkvalue = $value;
1218             $linkvalue =~ s/(\(|\))//g;
1219             my $operator = " and " unless $counter==0;
1220             push @link_loop, {link => $linkvalue, operator => $operator };
1221             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1222             if ($volume_number) {
1223             push @subfields_loop, {volumenum => $value};
1224             }
1225             else {
1226             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1227             }
1228             $counter++;
1229         }
1230         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1231         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1232         #push @marcsubjcts, $marcsubjct;
1233         #$subjct = $value;
1234
1235     }
1236     my $marcseriessarray=\@marcseries;
1237     return $marcseriessarray;
1238 }  #end getMARCseriess
1239
1240 =head2 GetFrameworkCode
1241
1242 =over 4
1243
1244     $frameworkcode = GetFrameworkCode( $biblionumber )
1245
1246 =back
1247
1248 =cut
1249
1250 sub GetFrameworkCode {
1251     my ( $biblionumber ) = @_;
1252     my $dbh = C4::Context->dbh;
1253     my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1254     $sth->execute($biblionumber);
1255     my ($frameworkcode) = $sth->fetchrow;
1256     return $frameworkcode;
1257 }
1258
1259 =head2 GetPublisherNameFromIsbn
1260
1261     $name = GetPublishercodeFromIsbn($isbn);
1262     if(defined $name){
1263         ...
1264     }
1265
1266 =cut
1267
1268 sub GetPublisherNameFromIsbn($){
1269     my $isbn = shift;
1270     $isbn =~ s/[- _]//g;
1271     $isbn =~ s/^0*//;
1272     my @codes = (split '-', DisplayISBN($isbn));
1273     my $code = $codes[0].$codes[1].$codes[2];
1274     my $dbh  = C4::Context->dbh;
1275     my $query = qq{
1276         SELECT distinct publishercode
1277         FROM   biblioitems
1278         WHERE  isbn LIKE ?
1279         AND    publishercode IS NOT NULL
1280         LIMIT 1
1281     };
1282     my $sth = $dbh->prepare($query);
1283     $sth->execute("$code%");
1284     my $name = $sth->fetchrow;
1285     return $name if length $name;
1286     return undef;
1287 }
1288
1289 =head2 TransformKohaToMarc
1290
1291 =over 4
1292
1293     $record = TransformKohaToMarc( $hash )
1294     This function builds partial MARC::Record from a hash
1295     Hash entries can be from biblio or biblioitems.
1296     This function is called in acquisition module, to create a basic catalogue entry from user entry
1297
1298 =back
1299
1300 =cut
1301
1302 sub TransformKohaToMarc {
1303
1304     my ( $hash ) = @_;
1305     my $dbh = C4::Context->dbh;
1306     my $sth =
1307     $dbh->prepare(
1308         "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
1309     );
1310     my $record = MARC::Record->new();
1311     foreach (keys %{$hash}) {
1312         &TransformKohaToMarcOneField( $sth, $record, $_,
1313             $hash->{$_}, '' );
1314         }
1315     return $record;
1316 }
1317
1318 =head2 TransformKohaToMarcOneField
1319
1320 =over 4
1321
1322     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1323
1324 =back
1325
1326 =cut
1327
1328 sub TransformKohaToMarcOneField {
1329     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1330     $frameworkcode='' unless $frameworkcode;
1331     my $tagfield;
1332     my $tagsubfield;
1333
1334     if ( !defined $sth ) {
1335         my $dbh = C4::Context->dbh;
1336         $sth = $dbh->prepare(
1337             "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
1338         );
1339     }
1340     $sth->execute( $frameworkcode, $kohafieldname );
1341     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1342         my $tag = $record->field($tagfield);
1343         if ($tag) {
1344             $tag->update( $tagsubfield => $value );
1345             $record->delete_field($tag);
1346             $record->insert_fields_ordered($tag);
1347         }
1348         else {
1349             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1350         }
1351     }
1352     return $record;
1353 }
1354
1355 =head2 TransformHtmlToXml
1356
1357 =over 4
1358
1359 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type )
1360
1361 $auth_type contains :
1362 - nothing : rebuild a biblio, un UNIMARC the encoding is in 100$a pos 26/27
1363 - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1364 - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1365
1366 =back
1367
1368 =cut
1369
1370 sub TransformHtmlToXml {
1371     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
1372     my $xml = MARC::File::XML::header('UTF-8');
1373     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
1374     MARC::File::XML->default_record_format($auth_type);
1375     # in UNIMARC, field 100 contains the encoding
1376     # check that there is one, otherwise the
1377     # MARC::Record->new_from_xml will fail (and Koha will die)
1378     my $unimarc_and_100_exist=0;
1379     $unimarc_and_100_exist=1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
1380     my $prevvalue;
1381     my $prevtag = -1;
1382     my $first   = 1;
1383     my $j       = -1;
1384     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
1385         if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
1386             # if we have a 100 field and it's values are not correct, skip them.
1387             # if we don't have any valid 100 field, we will create a default one at the end
1388             my $enc = substr( @$values[$i], 26, 2 );
1389             if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
1390                 $unimarc_and_100_exist=1;
1391             } else {
1392                 next;
1393             }
1394         }
1395         @$values[$i] =~ s/&/&amp;/g;
1396         @$values[$i] =~ s/</&lt;/g;
1397         @$values[$i] =~ s/>/&gt;/g;
1398         @$values[$i] =~ s/"/&quot;/g;
1399         @$values[$i] =~ s/'/&apos;/g;
1400 #         if ( !utf8::is_utf8( @$values[$i] ) ) {
1401 #             utf8::decode( @$values[$i] );
1402 #         }
1403         if ( ( @$tags[$i] ne $prevtag ) ) {
1404             $j++ unless ( @$tags[$i] eq "" );
1405             if ( !$first ) {
1406                 $xml .= "</datafield>\n";
1407                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
1408                     && ( @$values[$i] ne "" ) )
1409                 {
1410                     my $ind1 = substr( @$indicator[$j], 0, 1 );
1411                     my $ind2;
1412                     if ( @$indicator[$j] ) {
1413                         $ind2 = substr( @$indicator[$j], 1, 1 );
1414                     }
1415                     else {
1416                         warn "Indicator in @$tags[$i] is empty";
1417                         $ind2 = " ";
1418                     }
1419                     $xml .=
1420 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1421                     $xml .=
1422 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1423                     $first = 0;
1424                 }
1425                 else {
1426                     $first = 1;
1427                 }
1428             }
1429             else {
1430                 if ( @$values[$i] ne "" ) {
1431
1432                     # leader
1433                     if ( @$tags[$i] eq "000" ) {
1434                         $xml .= "<leader>@$values[$i]</leader>\n";
1435                         $first = 1;
1436
1437                         # rest of the fixed fields
1438                     }
1439                     elsif ( @$tags[$i] < 10 ) {
1440                         $xml .=
1441 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
1442                         $first = 1;
1443                     }
1444                     else {
1445                         my $ind1 = substr( @$indicator[$j], 0, 1 );
1446                         my $ind2 = substr( @$indicator[$j], 1, 1 );
1447                         $xml .=
1448 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1449                         $xml .=
1450 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1451                         $first = 0;
1452                     }
1453                 }
1454             }
1455         }
1456         else {    # @$tags[$i] eq $prevtag
1457             if ( @$values[$i] eq "" ) {
1458             }
1459             else {
1460                 if ($first) {
1461                     my $ind1 = substr( @$indicator[$j], 0, 1 );
1462                     my $ind2 = substr( @$indicator[$j], 1, 1 );
1463                     $xml .=
1464 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1465                     $first = 0;
1466                 }
1467                 $xml .=
1468 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1469             }
1470         }
1471         $prevtag = @$tags[$i];
1472     }
1473     $xml .= "</datafield>\n" if @$tags > 0;
1474     if (C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist) {
1475 #     warn "SETTING 100 for $auth_type";
1476         use POSIX qw(strftime);
1477         my $string = strftime( "%Y%m%d", localtime(time) );
1478         # set 50 to position 26 is biblios, 13 if authorities
1479         my $pos=26;
1480         $pos=13 if $auth_type eq 'UNIMARCAUTH';
1481         $string = sprintf( "%-*s", 35, $string );
1482         substr( $string, $pos , 6, "50" );
1483         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
1484         $xml .= "<subfield code=\"a\">$string</subfield>\n";
1485         $xml .= "</datafield>\n";
1486     }
1487     $xml .= MARC::File::XML::footer();
1488     return $xml;
1489 }
1490
1491 =head2 TransformHtmlToMarc
1492
1493     L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
1494     L<$params> is a ref to an array as below:
1495     {
1496         'tag_010_indicator1_531951' ,
1497         'tag_010_indicator2_531951' ,
1498         'tag_010_code_a_531951_145735' ,
1499         'tag_010_subfield_a_531951_145735' ,
1500         'tag_200_indicator1_873510' ,
1501         'tag_200_indicator2_873510' ,
1502         'tag_200_code_a_873510_673465' ,
1503         'tag_200_subfield_a_873510_673465' ,
1504         'tag_200_code_b_873510_704318' ,
1505         'tag_200_subfield_b_873510_704318' ,
1506         'tag_200_code_e_873510_280822' ,
1507         'tag_200_subfield_e_873510_280822' ,
1508         'tag_200_code_f_873510_110730' ,
1509         'tag_200_subfield_f_873510_110730' ,
1510     }
1511     L<$cgi> is the CGI object which containts the value.
1512     L<$record> is the MARC::Record object.
1513
1514 =cut
1515
1516 sub TransformHtmlToMarc {
1517     my $params = shift;
1518     my $cgi    = shift;
1519
1520     # explicitly turn on the UTF-8 flag for all
1521     # 'tag_' parameters to avoid incorrect character
1522     # conversion later on
1523     my $cgi_params = $cgi->Vars;
1524     foreach my $param_name (keys %$cgi_params) {
1525         if ($param_name =~ /^tag_/) {
1526             my $param_value = $cgi_params->{$param_name};
1527             if (utf8::decode($param_value)) {
1528                 $cgi_params->{$param_name} = $param_value;
1529             }
1530             # FIXME - need to do something if string is not valid UTF-8
1531         }
1532     }
1533
1534     # creating a new record
1535     my $record  = MARC::Record->new();
1536     my $i=0;
1537     my @fields;
1538     while ($params->[$i]){ # browse all CGI params
1539         my $param = $params->[$i];
1540         my $newfield=0;
1541         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
1542         if ($param eq 'biblionumber') {
1543             my ( $biblionumbertagfield, $biblionumbertagsubfield ) =
1544                 &GetMarcFromKohaField( "biblio.biblionumber", '' );
1545             if ($biblionumbertagfield < 10) {
1546                 $newfield = MARC::Field->new(
1547                     $biblionumbertagfield,
1548                     $cgi->param($param),
1549                 );
1550             } else {
1551                 $newfield = MARC::Field->new(
1552                     $biblionumbertagfield,
1553                     '',
1554                     '',
1555                     "$biblionumbertagsubfield" => $cgi->param($param),
1556                 );
1557             }
1558             push @fields,$newfield if($newfield);
1559         }
1560         elsif ($param =~ /^tag_(\d*)_indicator1_/){ # new field start when having 'input name="..._indicator1_..."
1561             my $tag  = $1;
1562
1563             my $ind1 = substr($cgi->param($param),0,1);
1564             my $ind2 = substr($cgi->param($params->[$i+1]),0,1);
1565             $newfield=0;
1566             my $j=$i+2;
1567
1568             if($tag < 10){ # no code for theses fields
1569     # in MARC editor, 000 contains the leader.
1570                 if ($tag eq '000' ) {
1571                     $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==24;
1572     # between 001 and 009 (included)
1573                 } elsif ($cgi->param($params->[$j+1]) ne '') {
1574                     $newfield = MARC::Field->new(
1575                         $tag,
1576                         $cgi->param($params->[$j+1]),
1577                     );
1578                 }
1579     # > 009, deal with subfields
1580             } else {
1581                 while(defined $params->[$j] && $params->[$j] =~ /_code_/){ # browse all it's subfield
1582                     my $inner_param = $params->[$j];
1583                     if ($newfield){
1584                         if($cgi->param($params->[$j+1]) ne ''){  # only if there is a value (code => value)
1585                             $newfield->add_subfields(
1586                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1])
1587                             );
1588                         }
1589                     } else {
1590                         if ( $cgi->param($params->[$j+1]) ne '' ) { # creating only if there is a value (code => value)
1591                             $newfield = MARC::Field->new(
1592                                 $tag,
1593                                 ''.$ind1,
1594                                 ''.$ind2,
1595                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
1596                             );
1597                         }
1598                     }
1599                     $j+=2;
1600                 }
1601             }
1602             push @fields,$newfield if($newfield);
1603         }
1604         $i++;
1605     }
1606
1607     $record->append_fields(@fields);
1608     return $record;
1609 }
1610
1611 # cache inverted MARC field map
1612 our $inverted_field_map;
1613
1614 =head2 TransformMarcToKoha
1615
1616 =over 4
1617
1618     $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
1619
1620 =back
1621
1622 Extract data from a MARC bib record into a hashref representing
1623 Koha biblio, biblioitems, and items fields.
1624
1625 =cut
1626 sub TransformMarcToKoha {
1627     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
1628
1629     my $result;
1630     $limit_table=$limit_table||0;
1631     $frameworkcode = '' unless defined $frameworkcode;
1632
1633     unless (defined $inverted_field_map) {
1634         $inverted_field_map = _get_inverted_marc_field_map();
1635     }
1636
1637     my %tables = ();
1638     if ( defined $limit_table && $limit_table eq 'items') {
1639         $tables{'items'} = 1;
1640     } else {
1641         $tables{'items'} = 1;
1642         $tables{'biblio'} = 1;
1643         $tables{'biblioitems'} = 1;
1644     }
1645
1646     # traverse through record
1647     MARCFIELD: foreach my $field ($record->fields()) {
1648         my $tag = $field->tag();
1649         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
1650         if ($field->is_control_field()) {
1651             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
1652             ENTRY: foreach my $entry (@{ $kohafields }) {
1653                 my ($subfield, $table, $column) = @{ $entry };
1654                 next ENTRY unless exists $tables{$table};
1655                 my $key = _disambiguate($table, $column);
1656                 if ($result->{$key}) {
1657                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($field->data() eq "")) {
1658                         $result->{$key} .= " | " . $field->data();
1659                     }
1660                 } else {
1661                     $result->{$key} = $field->data();
1662                 }
1663             }
1664         } else {
1665             # deal with subfields
1666             MARCSUBFIELD: foreach my $sf ($field->subfields()) {
1667                 my $code = $sf->[0];
1668                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
1669                 my $value = $sf->[1];
1670                 SFENTRY: foreach my $entry (@{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} }) {
1671                     my ($table, $column) = @{ $entry };
1672                     next SFENTRY unless exists $tables{$table};
1673                     my $key = _disambiguate($table, $column);
1674                     if ($result->{$key}) {
1675                         unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
1676                             $result->{$key} .= " | " . $value;
1677                         }
1678                     } else {
1679                         $result->{$key} = $value;
1680                     }
1681                 }
1682             }
1683         }
1684     }
1685
1686     # modify copyrightdate to keep only the 1st year found
1687     if (exists $result->{'copyrightdate'}) {
1688         my $temp = $result->{'copyrightdate'};
1689         $temp =~ m/c(\d\d\d\d)/;
1690         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
1691             $result->{'copyrightdate'} = $1;
1692         }
1693         else {                      # if no cYYYY, get the 1st date.
1694             $temp =~ m/(\d\d\d\d)/;
1695             $result->{'copyrightdate'} = $1;
1696         }
1697     }
1698
1699     # modify publicationyear to keep only the 1st year found
1700     if (exists $result->{'publicationyear'}) {
1701         my $temp = $result->{'publicationyear'};
1702         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
1703             $result->{'publicationyear'} = $1;
1704         }
1705         else {                      # if no cYYYY, get the 1st date.
1706             $temp =~ m/(\d\d\d\d)/;
1707             $result->{'publicationyear'} = $1;
1708         }
1709     }
1710
1711     return $result;
1712 }
1713
1714 sub _get_inverted_marc_field_map {
1715     my $field_map = {};
1716     my $relations = C4::Context->marcfromkohafield;
1717
1718     foreach my $frameworkcode (keys %{ $relations }) {
1719         foreach my $kohafield (keys %{ $relations->{$frameworkcode} }) {
1720             next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
1721             my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
1722             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
1723             my ($table, $column) = split /[.]/, $kohafield, 2;
1724             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
1725             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
1726         }
1727     }
1728     return $field_map;
1729 }
1730
1731 =head2 _disambiguate
1732
1733 =over 4
1734
1735 $newkey = _disambiguate($table, $field);
1736
1737 This is a temporary hack to distinguish between the
1738 following sets of columns when using TransformMarcToKoha.
1739
1740 items.cn_source & biblioitems.cn_source
1741 items.cn_sort & biblioitems.cn_sort
1742
1743 Columns that are currently NOT distinguished (FIXME
1744 due to lack of time to fully test) are:
1745
1746 biblio.notes and biblioitems.notes
1747 biblionumber
1748 timestamp
1749 biblioitemnumber
1750
1751 FIXME - this is necessary because prefixing each column
1752 name with the table name would require changing lots
1753 of code and templates, and exposing more of the DB
1754 structure than is good to the UI templates, particularly
1755 since biblio and bibloitems may well merge in a future
1756 version.  In the future, it would also be good to
1757 separate DB access and UI presentation field names
1758 more.
1759
1760 =back
1761
1762 =cut
1763
1764 sub _disambiguate {
1765     my ($table, $column) = @_;
1766     if ($column eq "cn_sort" or $column eq "cn_source") {
1767         return $table . '.' . $column;
1768     } else {
1769         return $column;
1770     }
1771
1772 }
1773
1774 =head2 get_koha_field_from_marc
1775
1776 =over 4
1777
1778 $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
1779
1780 Internal function to map data from the MARC record to a specific non-MARC field.
1781 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
1782
1783 =back
1784
1785 =cut
1786
1787 sub get_koha_field_from_marc {
1788     my ($koha_table,$koha_column,$record,$frameworkcode) = @_;
1789     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table.'.'.$koha_column, $frameworkcode );
1790     my $kohafield;
1791     foreach my $field ( $record->field($tagfield) ) {
1792         if ( $field->tag() < 10 ) {
1793             if ( $kohafield ) {
1794                 $kohafield .= " | " . $field->data();
1795             }
1796             else {
1797                 $kohafield = $field->data();
1798             }
1799         }
1800         else {
1801             if ( $field->subfields ) {
1802                 my @subfields = $field->subfields();
1803                 foreach my $subfieldcount ( 0 .. $#subfields ) {
1804                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
1805                         if ( $kohafield ) {
1806                             $kohafield .=
1807                               " | " . $subfields[$subfieldcount][1];
1808                         }
1809                         else {
1810                             $kohafield =
1811                               $subfields[$subfieldcount][1];
1812                         }
1813                     }
1814                 }
1815             }
1816         }
1817     }
1818     return $kohafield;
1819 }
1820
1821
1822 =head2 TransformMarcToKohaOneField
1823
1824 =over 4
1825
1826 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
1827
1828 =back
1829
1830 =cut
1831
1832 sub TransformMarcToKohaOneField {
1833
1834     # FIXME ? if a field has a repeatable subfield that is used in old-db,
1835     # only the 1st will be retrieved...
1836     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
1837     my $res = "";
1838     my ( $tagfield, $subfield ) =
1839       GetMarcFromKohaField( $kohatable . "." . $kohafield,
1840         $frameworkcode );
1841     foreach my $field ( $record->field($tagfield) ) {
1842         if ( $field->tag() < 10 ) {
1843             if ( $result->{$kohafield} ) {
1844                 $result->{$kohafield} .= " | " . $field->data();
1845             }
1846             else {
1847                 $result->{$kohafield} = $field->data();
1848             }
1849         }
1850         else {
1851             if ( $field->subfields ) {
1852                 my @subfields = $field->subfields();
1853                 foreach my $subfieldcount ( 0 .. $#subfields ) {
1854                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
1855                         if ( $result->{$kohafield} ) {
1856                             $result->{$kohafield} .=
1857                               " | " . $subfields[$subfieldcount][1];
1858                         }
1859                         else {
1860                             $result->{$kohafield} =
1861                               $subfields[$subfieldcount][1];
1862                         }
1863                     }
1864                 }
1865             }
1866         }
1867     }
1868     return $result;
1869 }
1870
1871 =head1  OTHER FUNCTIONS
1872
1873
1874 =head2 PrepareItemrecordDisplay
1875
1876 =over 4
1877
1878 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
1879
1880 Returns a hash with all the fields for Display a given item data in a template
1881
1882 =back
1883
1884 =cut
1885
1886 sub PrepareItemrecordDisplay {
1887
1888     my ( $bibnum, $itemnum, $defaultvalues ) = @_;
1889
1890     my $dbh = C4::Context->dbh;
1891     my $frameworkcode = &GetFrameworkCode( $bibnum );
1892     my ( $itemtagfield, $itemtagsubfield ) =
1893       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
1894     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
1895     my $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum) if ($itemnum);
1896     my @loop_data;
1897     my $authorised_values_sth =
1898       $dbh->prepare(
1899 "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib"
1900       );
1901     foreach my $tag ( sort keys %{$tagslib} ) {
1902         my $previous_tag = '';
1903         if ( $tag ne '' ) {
1904             # loop through each subfield
1905             my $cntsubf;
1906             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
1907                 next if ( subfield_is_koha_internal_p($subfield) );
1908                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
1909                 my %subfield_data;
1910                 $subfield_data{tag}           = $tag;
1911                 $subfield_data{subfield}      = $subfield;
1912                 $subfield_data{countsubfield} = $cntsubf++;
1913                 $subfield_data{kohafield}     =
1914                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
1915
1916          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
1917                 $subfield_data{marc_lib} = $tagslib->{$tag}->{$subfield}->{lib};
1918                 $subfield_data{mandatory} =
1919                   $tagslib->{$tag}->{$subfield}->{mandatory};
1920                 $subfield_data{repeatable} =
1921                   $tagslib->{$tag}->{$subfield}->{repeatable};
1922                 $subfield_data{hidden} = "display:none"
1923                   if $tagslib->{$tag}->{$subfield}->{hidden};
1924                 my ( $x, $value );
1925                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
1926                   if ($itemrecord);
1927                 $value =~ s/"/&quot;/g;
1928
1929                 # search for itemcallnumber if applicable
1930                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
1931                     'items.itemcallnumber'
1932                     && C4::Context->preference('itemcallnumber') )
1933                 {
1934                     my $CNtag =
1935                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
1936                     my $CNsubfield =
1937                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
1938                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
1939                     if ($temp) {
1940                         $value = $temp->subfield($CNsubfield);
1941                     }
1942                 }
1943                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
1944                     'items.itemcallnumber'
1945                     && $defaultvalues->{'callnumber'} )
1946                 {
1947                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
1948                     unless ($temp) {
1949                         $value = $defaultvalues->{'callnumber'};
1950                     }
1951                 }
1952                 if ( ($tagslib->{$tag}->{$subfield}->{kohafield} eq
1953                     'items.holdingbranch' ||
1954                     $tagslib->{$tag}->{$subfield}->{kohafield} eq
1955                     'items.homebranch')
1956                     && $defaultvalues->{'branchcode'} )
1957                 {
1958                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
1959                     unless ($temp) {
1960                         $value = $defaultvalues->{branchcode};
1961                     }
1962                 }
1963                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
1964                     my @authorised_values;
1965                     my %authorised_lib;
1966
1967                     # builds list, depending on authorised value...
1968                     #---- branch
1969                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
1970                         "branches" )
1971                     {
1972                         if ( ( C4::Context->preference("IndependantBranches") )
1973                             && ( C4::Context->userenv->{flags} != 1 ) )
1974                         {
1975                             my $sth =
1976                               $dbh->prepare(
1977                                 "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname"
1978                               );
1979                             $sth->execute( C4::Context->userenv->{branch} );
1980                             push @authorised_values, ""
1981                               unless (
1982                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
1983                             while ( my ( $branchcode, $branchname ) =
1984                                 $sth->fetchrow_array )
1985                             {
1986                                 push @authorised_values, $branchcode;
1987                                 $authorised_lib{$branchcode} = $branchname;
1988                             }
1989                         }
1990                         else {
1991                             my $sth =
1992                               $dbh->prepare(
1993                                 "SELECT branchcode,branchname FROM branches ORDER BY branchname"
1994                               );
1995                             $sth->execute;
1996                             push @authorised_values, ""
1997                               unless (
1998                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
1999                             while ( my ( $branchcode, $branchname ) =
2000                                 $sth->fetchrow_array )
2001                             {
2002                                 push @authorised_values, $branchcode;
2003                                 $authorised_lib{$branchcode} = $branchname;
2004                             }
2005                         }
2006
2007                         #----- itemtypes
2008                     }
2009                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2010                         "itemtypes" )
2011                     {
2012                         my $sth =
2013                           $dbh->prepare(
2014                             "SELECT itemtype,description FROM itemtypes ORDER BY description"
2015                           );
2016                         $sth->execute;
2017                         push @authorised_values, ""
2018                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2019                         while ( my ( $itemtype, $description ) =
2020                             $sth->fetchrow_array )
2021                         {
2022                             push @authorised_values, $itemtype;
2023                             $authorised_lib{$itemtype} = $description;
2024                         }
2025
2026                         #---- "true" authorised value
2027                     }
2028                     else {
2029                         $authorised_values_sth->execute(
2030                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2031                         push @authorised_values, ""
2032                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2033                         while ( my ( $value, $lib ) =
2034                             $authorised_values_sth->fetchrow_array )
2035                         {
2036                             push @authorised_values, $value;
2037                             $authorised_lib{$value} = $lib;
2038                         }
2039                     }
2040                     $subfield_data{marc_value} = CGI::scrolling_list(
2041                         -name     => 'field_value',
2042                         -values   => \@authorised_values,
2043                         -default  => "$value",
2044                         -labels   => \%authorised_lib,
2045                         -size     => 1,
2046                         -tabindex => '',
2047                         -multiple => 0,
2048                     );
2049                 }
2050                 else {
2051                     $subfield_data{marc_value} =
2052 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=\"50\" maxlength=\"255\" />";
2053                 }
2054                 push( @loop_data, \%subfield_data );
2055             }
2056         }
2057     }
2058     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2059       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2060     return {
2061         'itemtagfield'    => $itemtagfield,
2062         'itemtagsubfield' => $itemtagsubfield,
2063         'itemnumber'      => $itemnumber,
2064         'iteminformation' => \@loop_data
2065     };
2066 }
2067 #"
2068
2069 #
2070 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2071 # at the same time
2072 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2073 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2074 # =head2 ModZebrafiles
2075 #
2076 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2077 #
2078 # =cut
2079 #
2080 # sub ModZebrafiles {
2081 #
2082 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2083 #
2084 #     my $op;
2085 #     my $zebradir =
2086 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2087 #     unless ( opendir( DIR, "$zebradir" ) ) {
2088 #         warn "$zebradir not found";
2089 #         return;
2090 #     }
2091 #     closedir DIR;
2092 #     my $filename = $zebradir . $biblionumber;
2093 #
2094 #     if ($record) {
2095 #         open( OUTPUT, ">", $filename . ".xml" );
2096 #         print OUTPUT $record;
2097 #         close OUTPUT;
2098 #     }
2099 # }
2100
2101 =head2 ModZebra
2102
2103 =over 4
2104
2105 ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2106
2107     $biblionumber is the biblionumber we want to index
2108     $op is specialUpdate or delete, and is used to know what we want to do
2109     $server is the server that we want to update
2110     $oldRecord is the MARC::Record containing the previous version of the record.  This is used only when
2111       NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2112       do an update.
2113     $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.
2114
2115 =back
2116
2117 =cut
2118
2119 sub ModZebra {
2120 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2121     my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2122     my $dbh=C4::Context->dbh;
2123
2124     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2125     # at the same time
2126     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2127     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2128
2129     if (C4::Context->preference("NoZebra")) {
2130         # lock the nozebra table : we will read index lines, update them in Perl process
2131         # and write everything in 1 transaction.
2132         # lock the table to avoid someone else overwriting what we are doing
2133         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2134         my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2135         if ($op eq 'specialUpdate') {
2136             # OK, we have to add or update the record
2137             # 1st delete (virtually, in indexes), if record actually exists
2138             if ($oldRecord) {
2139                 %result = _DelBiblioNoZebra($biblionumber,$oldRecord,$server);
2140             }
2141             # ... add the record
2142             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
2143         } else {
2144             # it's a deletion, delete the record...
2145             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2146             %result=_DelBiblioNoZebra($biblionumber,$oldRecord,$server);
2147         }
2148         # ok, now update the database...
2149         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2150         foreach my $key (keys %result) {
2151             foreach my $index (keys %{$result{$key}}) {
2152                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
2153             }
2154         }
2155         $dbh->do('UNLOCK TABLES');
2156     } else {
2157         #
2158         # we use zebra, just fill zebraqueue table
2159         #
2160         my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2161                          WHERE server = ?
2162                          AND   biblio_auth_number = ?
2163                          AND   operation = ?
2164                          AND   done = 0";
2165         my $check_sth = $dbh->prepare_cached($check_sql);
2166         $check_sth->execute($server, $biblionumber, $op);
2167         my ($count) = $check_sth->fetchrow_array;
2168         $check_sth->finish();
2169         if ($count == 0) {
2170             my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2171             $sth->execute($biblionumber,$server,$op);
2172             $sth->finish;
2173         }
2174     }
2175 }
2176
2177 =head2 GetNoZebraIndexes
2178
2179     %indexes = GetNoZebraIndexes;
2180
2181     return the data from NoZebraIndexes syspref.
2182
2183 =cut
2184
2185 sub GetNoZebraIndexes {
2186     my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2187     my %indexes;
2188     INDEX: foreach my $line (split /['"],[\n\r]*/,$no_zebra_indexes) {
2189         $line =~ /(.*)=>(.*)/;
2190         my $index = $1; # initial ' or " is removed afterwards
2191         my $fields = $2;
2192         $index =~ s/'|"|\s//g;
2193         $fields =~ s/'|"|\s//g;
2194         $indexes{$index}=$fields;
2195     }
2196     return %indexes;
2197 }
2198
2199 =head1 INTERNAL FUNCTIONS
2200
2201 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2202
2203     function to delete a biblio in NoZebra indexes
2204     This function does NOT delete anything in database : it reads all the indexes entries
2205     that have to be deleted & delete them in the hash
2206     The SQL part is done either :
2207     - after the Add if we are modifying a biblio (delete + add again)
2208     - immediatly after this sub if we are doing a true deletion.
2209     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2210
2211 =cut
2212
2213
2214 sub _DelBiblioNoZebra {
2215     my ($biblionumber, $record, $server)=@_;
2216
2217     # Get the indexes
2218     my $dbh = C4::Context->dbh;
2219     # Get the indexes
2220     my %index;
2221     my $title;
2222     if ($server eq 'biblioserver') {
2223         %index=GetNoZebraIndexes;
2224         # get title of the record (to store the 10 first letters with the index)
2225         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title', ''); # FIXME: should be GetFrameworkCode($biblionumber) ??
2226         $title = lc($record->subfield($titletag,$titlesubfield));
2227     } else {
2228         # for authorities, the "title" is the $a mainentry
2229         my ($auth_type_tag, $auth_type_sf) = C4::AuthoritiesMarc::get_auth_type_location();
2230         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield($auth_type_tag, $auth_type_sf));
2231         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2232         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2233         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
2234         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
2235         $index{'auth_type'}    = "${auth_type_tag}${auth_type_sf}";
2236     }
2237
2238     my %result;
2239     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2240     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2241     # limit to 10 char, should be enough, and limit the DB size
2242     $title = substr($title,0,10);
2243     #parse each field
2244     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2245     foreach my $field ($record->fields()) {
2246         #parse each subfield
2247         next if $field->tag <10;
2248         foreach my $subfield ($field->subfields()) {
2249             my $tag = $field->tag();
2250             my $subfieldcode = $subfield->[0];
2251             my $indexed=0;
2252             # check each index to see if the subfield is stored somewhere
2253             # otherwise, store it in __RAW__ index
2254             foreach my $key (keys %index) {
2255 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2256                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2257                     $indexed=1;
2258                     my $line= lc $subfield->[1];
2259                     # remove meaningless value in the field...
2260                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2261                     # ... and split in words
2262                     foreach (split / /,$line) {
2263                         next unless $_; # skip  empty values (multiple spaces)
2264                         # if the entry is already here, do nothing, the biblionumber has already be removed
2265                         unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) ) {
2266                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2267                             $sth2->execute($server,$key,$_);
2268                             my $existing_biblionumbers = $sth2->fetchrow;
2269                             # it exists
2270                             if ($existing_biblionumbers) {
2271 #                                 warn " existing for $key $_: $existing_biblionumbers";
2272                                 $result{$key}->{$_} =$existing_biblionumbers;
2273                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2274                             }
2275                         }
2276                     }
2277                 }
2278             }
2279             # the subfield is not indexed, store it in __RAW__ index anyway
2280             unless ($indexed) {
2281                 my $line= lc $subfield->[1];
2282                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2283                 # ... and split in words
2284                 foreach (split / /,$line) {
2285                     next unless $_; # skip  empty values (multiple spaces)
2286                     # if the entry is already here, do nothing, the biblionumber has already be removed
2287                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2288                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2289                         $sth2->execute($server,'__RAW__',$_);
2290                         my $existing_biblionumbers = $sth2->fetchrow;
2291                         # it exists
2292                         if ($existing_biblionumbers) {
2293                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
2294                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2295                         }
2296                     }
2297                 }
2298             }
2299         }
2300     }
2301     return %result;
2302 }
2303
2304 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2305
2306     function to add a biblio in NoZebra indexes
2307
2308 =cut
2309
2310 sub _AddBiblioNoZebra {
2311     my ($biblionumber, $record, $server, %result)=@_;
2312     my $dbh = C4::Context->dbh;
2313     # Get the indexes
2314     my %index;
2315     my $title;
2316     if ($server eq 'biblioserver') {
2317         %index=GetNoZebraIndexes;
2318         # get title of the record (to store the 10 first letters with the index)
2319         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title', ''); # FIXME: should be GetFrameworkCode($biblionumber) ??
2320         $title = lc($record->subfield($titletag,$titlesubfield));
2321     } else {
2322         # warn "server : $server";
2323         # for authorities, the "title" is the $a mainentry
2324         my ($auth_type_tag, $auth_type_sf) = C4::AuthoritiesMarc::get_auth_type_location();
2325         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield($auth_type_tag, $auth_type_sf));
2326         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2327         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2328         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
2329         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
2330         $index{'auth_type'}    = "${auth_type_tag}${auth_type_sf}";
2331     }
2332
2333     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2334     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
2335     # limit to 10 char, should be enough, and limit the DB size
2336     $title = substr($title,0,10);
2337     #parse each field
2338     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2339     foreach my $field ($record->fields()) {
2340         #parse each subfield
2341         ###FIXME: impossible to index a 001-009 value with NoZebra
2342         next if $field->tag <10;
2343         foreach my $subfield ($field->subfields()) {
2344             my $tag = $field->tag();
2345             my $subfieldcode = $subfield->[0];
2346             my $indexed=0;
2347 #             warn "INDEXING :".$subfield->[1];
2348             # check each index to see if the subfield is stored somewhere
2349             # otherwise, store it in __RAW__ index
2350             foreach my $key (keys %index) {
2351 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2352                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2353                     $indexed=1;
2354                     my $line= lc $subfield->[1];
2355                     # remove meaningless value in the field...
2356                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2357                     # ... and split in words
2358                     foreach (split / /,$line) {
2359                         next unless $_; # skip  empty values (multiple spaces)
2360                         # if the entry is already here, improve weight
2361 #                         warn "managing $_";
2362                         if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/) {
2363                             my $weight = $1 + 1;
2364                             $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2365                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2366                         } else {
2367                             # get the value if it exist in the nozebra table, otherwise, create it
2368                             $sth2->execute($server,$key,$_);
2369                             my $existing_biblionumbers = $sth2->fetchrow;
2370                             # it exists
2371                             if ($existing_biblionumbers) {
2372                                 $result{$key}->{"$_"} =$existing_biblionumbers;
2373                                 my $weight = defined $1 ? $1 + 1 : 1;
2374                                 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2375                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2376                             # create a new ligne for this entry
2377                             } else {
2378 #                             warn "INSERT : $server / $key / $_";
2379                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
2380                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
2381                             }
2382                         }
2383                     }
2384                 }
2385             }
2386             # the subfield is not indexed, store it in __RAW__ index anyway
2387             unless ($indexed) {
2388                 my $line= lc $subfield->[1];
2389                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2390                 # ... and split in words
2391                 foreach (split / /,$line) {
2392                     next unless $_; # skip  empty values (multiple spaces)
2393                     # if the entry is already here, improve weight
2394                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/) {
2395                         my $weight=$1+1;
2396                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2397                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2398                     } else {
2399                         # get the value if it exist in the nozebra table, otherwise, create it
2400                         $sth2->execute($server,'__RAW__',$_);
2401                         my $existing_biblionumbers = $sth2->fetchrow;
2402                         # it exists
2403                         if ($existing_biblionumbers) {
2404                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
2405                             my $weight=$1+1;
2406                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2407                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2408                         # create a new ligne for this entry
2409                         } else {
2410                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
2411                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
2412                         }
2413                     }
2414                 }
2415             }
2416         }
2417     }
2418     return %result;
2419 }
2420
2421
2422 =head2 _find_value
2423
2424 =over 4
2425
2426 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2427
2428 Find the given $subfield in the given $tag in the given
2429 MARC::Record $record.  If the subfield is found, returns
2430 the (indicators, value) pair; otherwise, (undef, undef) is
2431 returned.
2432
2433 PROPOSITION :
2434 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2435 I suggest we export it from this module.
2436
2437 =back
2438
2439 =cut
2440
2441 sub _find_value {
2442     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2443     my @result;
2444     my $indicator;
2445     if ( $tagfield < 10 ) {
2446         if ( $record->field($tagfield) ) {
2447             push @result, $record->field($tagfield)->data();
2448         }
2449         else {
2450             push @result, "";
2451         }
2452     }
2453     else {
2454         foreach my $field ( $record->field($tagfield) ) {
2455             my @subfields = $field->subfields();
2456             foreach my $subfield (@subfields) {
2457                 if ( @$subfield[0] eq $insubfield ) {
2458                     push @result, @$subfield[1];
2459                     $indicator = $field->indicator(1) . $field->indicator(2);
2460                 }
2461             }
2462         }
2463     }
2464     return ( $indicator, @result );
2465 }
2466
2467 =head2 _koha_marc_update_bib_ids
2468
2469 =over 4
2470
2471 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2472
2473 Internal function to add or update biblionumber and biblioitemnumber to
2474 the MARC XML.
2475
2476 =back
2477
2478 =cut
2479
2480 sub _koha_marc_update_bib_ids {
2481     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
2482
2483     # we must add bibnum and bibitemnum in MARC::Record...
2484     # we build the new field with biblionumber and biblioitemnumber
2485     # we drop the original field
2486     # we add the new builded field.
2487     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
2488     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
2489
2490     if ($biblio_tag != $biblioitem_tag) {
2491         # biblionumber & biblioitemnumber are in different fields
2492
2493         # deal with biblionumber
2494         my ($new_field, $old_field);
2495         if ($biblio_tag < 10) {
2496             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
2497         } else {
2498             $new_field =
2499               MARC::Field->new( $biblio_tag, '', '',
2500                 "$biblio_subfield" => $biblionumber );
2501         }
2502
2503         # drop old field and create new one...
2504         $old_field = $record->field($biblio_tag);
2505         $record->delete_field($old_field) if $old_field;
2506         $record->append_fields($new_field);
2507
2508         # deal with biblioitemnumber
2509         if ($biblioitem_tag < 10) {
2510             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
2511         } else {
2512             $new_field =
2513               MARC::Field->new( $biblioitem_tag, '', '',
2514                 "$biblioitem_subfield" => $biblioitemnumber, );
2515         }
2516         # drop old field and create new one...
2517         $old_field = $record->field($biblioitem_tag);
2518         $record->delete_field($old_field) if $old_field;
2519         $record->insert_fields_ordered($new_field);
2520
2521     } else {
2522         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
2523         my $new_field = MARC::Field->new(
2524             $biblio_tag, '', '',
2525             "$biblio_subfield" => $biblionumber,
2526             "$biblioitem_subfield" => $biblioitemnumber
2527         );
2528
2529         # drop old field and create new one...
2530         my $old_field = $record->field($biblio_tag);
2531         $record->delete_field($old_field) if $old_field;
2532         $record->insert_fields_ordered($new_field);
2533     }
2534 }
2535
2536 =head2 _koha_marc_update_biblioitem_cn_sort
2537
2538 =over 4
2539
2540 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2541
2542 =back
2543
2544 Given a MARC bib record and the biblioitem hash, update the
2545 subfield that contains a copy of the value of biblioitems.cn_sort.
2546
2547 =cut
2548
2549 sub _koha_marc_update_biblioitem_cn_sort {
2550     my $marc = shift;
2551     my $biblioitem = shift;
2552     my $frameworkcode= shift;
2553
2554     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.cn_sort",$frameworkcode);
2555     return unless $biblioitem_tag;
2556
2557     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2558
2559     if (my $field = $marc->field($biblioitem_tag)) {
2560         $field->delete_subfield(code => $biblioitem_subfield);
2561         if ($cn_sort ne '') {
2562             $field->add_subfields($biblioitem_subfield => $cn_sort);
2563         }
2564     } else {
2565         # if we get here, no biblioitem tag is present in the MARC record, so
2566         # we'll create it if $cn_sort is not empty -- this would be
2567         # an odd combination of events, however
2568         if ($cn_sort) {
2569             $marc->insert_grouped_field(MARC::Field->new($biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort));
2570         }
2571     }
2572 }
2573
2574 =head2 _koha_add_biblio
2575
2576 =over 4
2577
2578 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2579
2580 Internal function to add a biblio ($biblio is a hash with the values)
2581
2582 =back
2583
2584 =cut
2585
2586 sub _koha_add_biblio {
2587     my ( $dbh, $biblio, $frameworkcode ) = @_;
2588
2589     my $error;
2590
2591     # set the series flag
2592     my $serial = 0;
2593     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
2594
2595     my $query =
2596         "INSERT INTO biblio
2597         SET frameworkcode = ?,
2598             author = ?,
2599             title = ?,
2600             unititle =?,
2601             notes = ?,
2602             serial = ?,
2603             seriestitle = ?,
2604             copyrightdate = ?,
2605             datecreated=NOW(),
2606             abstract = ?
2607         ";
2608     my $sth = $dbh->prepare($query);
2609     $sth->execute(
2610         $frameworkcode,
2611         $biblio->{'author'},
2612         $biblio->{'title'},
2613         $biblio->{'unititle'},
2614         $biblio->{'notes'},
2615         $serial,
2616         $biblio->{'seriestitle'},
2617         $biblio->{'copyrightdate'},
2618         $biblio->{'abstract'}
2619     );
2620
2621     my $biblionumber = $dbh->{'mysql_insertid'};
2622     if ( $dbh->errstr ) {
2623         $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
2624         warn $error;
2625     }
2626
2627     $sth->finish();
2628     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2629     return ($biblionumber,$error);
2630 }
2631
2632 =head2 _koha_modify_biblio
2633
2634 =over 4
2635
2636 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2637
2638 Internal function for updating the biblio table
2639
2640 =back
2641
2642 =cut
2643
2644 sub _koha_modify_biblio {
2645     my ( $dbh, $biblio, $frameworkcode ) = @_;
2646     my $error;
2647
2648     my $query = "
2649         UPDATE biblio
2650         SET    frameworkcode = ?,
2651                author = ?,
2652                title = ?,
2653                unititle = ?,
2654                notes = ?,
2655                serial = ?,
2656                seriestitle = ?,
2657                copyrightdate = ?,
2658                abstract = ?
2659         WHERE  biblionumber = ?
2660         "
2661     ;
2662     my $sth = $dbh->prepare($query);
2663
2664     $sth->execute(
2665         $frameworkcode,
2666         $biblio->{'author'},
2667         $biblio->{'title'},
2668         $biblio->{'unititle'},
2669         $biblio->{'notes'},
2670         $biblio->{'serial'},
2671         $biblio->{'seriestitle'},
2672         $biblio->{'copyrightdate'},
2673         $biblio->{'abstract'},
2674         $biblio->{'biblionumber'}
2675     ) if $biblio->{'biblionumber'};
2676
2677     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2678         $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
2679         warn $error;
2680     }
2681     return ( $biblio->{'biblionumber'},$error );
2682 }
2683
2684 =head2 _koha_modify_biblioitem_nonmarc
2685
2686 =over 4
2687
2688 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2689
2690 Updates biblioitems row except for marc and marcxml, which should be changed
2691 via ModBiblioMarc
2692
2693 =back
2694
2695 =cut
2696
2697 sub _koha_modify_biblioitem_nonmarc {
2698     my ( $dbh, $biblioitem ) = @_;
2699     my $error;
2700
2701     # re-calculate the cn_sort, it may have changed
2702     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2703
2704     my $query =
2705     "UPDATE biblioitems
2706     SET biblionumber    = ?,
2707         volume          = ?,
2708         number          = ?,
2709         itemtype        = ?,
2710         isbn            = ?,
2711         issn            = ?,
2712         publicationyear = ?,
2713         publishercode   = ?,
2714         volumedate      = ?,
2715         volumedesc      = ?,
2716         collectiontitle = ?,
2717         collectionissn  = ?,
2718         collectionvolume= ?,
2719         editionstatement= ?,
2720         editionresponsibility = ?,
2721         illus           = ?,
2722         pages           = ?,
2723         notes           = ?,
2724         size            = ?,
2725         place           = ?,
2726         lccn            = ?,
2727         url             = ?,
2728         cn_source       = ?,
2729         cn_class        = ?,
2730         cn_item         = ?,
2731         cn_suffix       = ?,
2732         cn_sort         = ?,
2733         totalissues     = ?
2734         where biblioitemnumber = ?
2735         ";
2736     my $sth = $dbh->prepare($query);
2737     $sth->execute(
2738         $biblioitem->{'biblionumber'},
2739         $biblioitem->{'volume'},
2740         $biblioitem->{'number'},
2741         $biblioitem->{'itemtype'},
2742         $biblioitem->{'isbn'},
2743         $biblioitem->{'issn'},
2744         $biblioitem->{'publicationyear'},
2745         $biblioitem->{'publishercode'},
2746         $biblioitem->{'volumedate'},
2747         $biblioitem->{'volumedesc'},
2748         $biblioitem->{'collectiontitle'},
2749         $biblioitem->{'collectionissn'},
2750         $biblioitem->{'collectionvolume'},
2751         $biblioitem->{'editionstatement'},
2752         $biblioitem->{'editionresponsibility'},
2753         $biblioitem->{'illus'},
2754         $biblioitem->{'pages'},
2755         $biblioitem->{'bnotes'},
2756         $biblioitem->{'size'},
2757         $biblioitem->{'place'},
2758         $biblioitem->{'lccn'},
2759         $biblioitem->{'url'},
2760         $biblioitem->{'biblioitems.cn_source'},
2761         $biblioitem->{'cn_class'},
2762         $biblioitem->{'cn_item'},
2763         $biblioitem->{'cn_suffix'},
2764         $cn_sort,
2765         $biblioitem->{'totalissues'},
2766         $biblioitem->{'biblioitemnumber'}
2767     );
2768     if ( $dbh->errstr ) {
2769         $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
2770         warn $error;
2771     }
2772     return ($biblioitem->{'biblioitemnumber'},$error);
2773 }
2774
2775 =head2 _koha_add_biblioitem
2776
2777 =over 4
2778
2779 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
2780
2781 Internal function to add a biblioitem
2782
2783 =back
2784
2785 =cut
2786
2787 sub _koha_add_biblioitem {
2788     my ( $dbh, $biblioitem ) = @_;
2789     my $error;
2790
2791     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2792     my $query =
2793     "INSERT INTO biblioitems SET
2794         biblionumber    = ?,
2795         volume          = ?,
2796         number          = ?,
2797         itemtype        = ?,
2798         isbn            = ?,
2799         issn            = ?,
2800         publicationyear = ?,
2801         publishercode   = ?,
2802         volumedate      = ?,
2803         volumedesc      = ?,
2804         collectiontitle = ?,
2805         collectionissn  = ?,
2806         collectionvolume= ?,
2807         editionstatement= ?,
2808         editionresponsibility = ?,
2809         illus           = ?,
2810         pages           = ?,
2811         notes           = ?,
2812         size            = ?,
2813         place           = ?,
2814         lccn            = ?,
2815         marc            = ?,
2816         url             = ?,
2817         cn_source       = ?,
2818         cn_class        = ?,
2819         cn_item         = ?,
2820         cn_suffix       = ?,
2821         cn_sort         = ?,
2822         totalissues     = ?
2823         ";
2824     my $sth = $dbh->prepare($query);
2825     $sth->execute(
2826         $biblioitem->{'biblionumber'},
2827         $biblioitem->{'volume'},
2828         $biblioitem->{'number'},
2829         $biblioitem->{'itemtype'},
2830         $biblioitem->{'isbn'},
2831         $biblioitem->{'issn'},
2832         $biblioitem->{'publicationyear'},
2833         $biblioitem->{'publishercode'},
2834         $biblioitem->{'volumedate'},
2835         $biblioitem->{'volumedesc'},
2836         $biblioitem->{'collectiontitle'},
2837         $biblioitem->{'collectionissn'},
2838         $biblioitem->{'collectionvolume'},
2839         $biblioitem->{'editionstatement'},
2840         $biblioitem->{'editionresponsibility'},
2841         $biblioitem->{'illus'},
2842         $biblioitem->{'pages'},
2843         $biblioitem->{'bnotes'},
2844         $biblioitem->{'size'},
2845         $biblioitem->{'place'},
2846         $biblioitem->{'lccn'},
2847         $biblioitem->{'marc'},
2848         $biblioitem->{'url'},
2849         $biblioitem->{'biblioitems.cn_source'},
2850         $biblioitem->{'cn_class'},
2851         $biblioitem->{'cn_item'},
2852         $biblioitem->{'cn_suffix'},
2853         $cn_sort,
2854         $biblioitem->{'totalissues'}
2855     );
2856     my $bibitemnum = $dbh->{'mysql_insertid'};
2857     if ( $dbh->errstr ) {
2858         $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
2859         warn $error;
2860     }
2861     $sth->finish();
2862     return ($bibitemnum,$error);
2863 }
2864
2865 =head2 _koha_delete_biblio
2866
2867 =over 4
2868
2869 $error = _koha_delete_biblio($dbh,$biblionumber);
2870
2871 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2872
2873 C<$dbh> - the database handle
2874 C<$biblionumber> - the biblionumber of the biblio to be deleted
2875
2876 =back
2877
2878 =cut
2879
2880 # FIXME: add error handling
2881
2882 sub _koha_delete_biblio {
2883     my ( $dbh, $biblionumber ) = @_;
2884
2885     # get all the data for this biblio
2886     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2887     $sth->execute($biblionumber);
2888
2889     if ( my $data = $sth->fetchrow_hashref ) {
2890
2891         # save the record in deletedbiblio
2892         # find the fields to save
2893         my $query = "INSERT INTO deletedbiblio SET ";
2894         my @bind  = ();
2895         foreach my $temp ( keys %$data ) {
2896             $query .= "$temp = ?,";
2897             push( @bind, $data->{$temp} );
2898         }
2899
2900         # replace the last , by ",?)"
2901         $query =~ s/\,$//;
2902         my $bkup_sth = $dbh->prepare($query);
2903         $bkup_sth->execute(@bind);
2904         $bkup_sth->finish;
2905
2906         # delete the biblio
2907         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2908         $del_sth->execute($biblionumber);
2909         $del_sth->finish;
2910     }
2911     $sth->finish;
2912     return undef;
2913 }
2914
2915 =head2 _koha_delete_biblioitems
2916
2917 =over 4
2918
2919 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2920
2921 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2922
2923 C<$dbh> - the database handle
2924 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2925
2926 =back
2927
2928 =cut
2929
2930 # FIXME: add error handling
2931
2932 sub _koha_delete_biblioitems {
2933     my ( $dbh, $biblioitemnumber ) = @_;
2934
2935     # get all the data for this biblioitem
2936     my $sth =
2937       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2938     $sth->execute($biblioitemnumber);
2939
2940     if ( my $data = $sth->fetchrow_hashref ) {
2941
2942         # save the record in deletedbiblioitems
2943         # find the fields to save
2944         my $query = "INSERT INTO deletedbiblioitems SET ";
2945         my @bind  = ();
2946         foreach my $temp ( keys %$data ) {
2947             $query .= "$temp = ?,";
2948             push( @bind, $data->{$temp} );
2949         }
2950
2951         # replace the last , by ",?)"
2952         $query =~ s/\,$//;
2953         my $bkup_sth = $dbh->prepare($query);
2954         $bkup_sth->execute(@bind);
2955         $bkup_sth->finish;
2956
2957         # delete the biblioitem
2958         my $del_sth =
2959           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2960         $del_sth->execute($biblioitemnumber);
2961         $del_sth->finish;
2962     }
2963     $sth->finish;
2964     return undef;
2965 }
2966
2967 =head1 UNEXPORTED FUNCTIONS
2968
2969 =head2 ModBiblioMarc
2970
2971     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
2972
2973     Add MARC data for a biblio to koha
2974
2975     Function exported, but should NOT be used, unless you really know what you're doing
2976
2977 =cut
2978
2979 sub ModBiblioMarc {
2980
2981 # pass the MARC::Record to this function, and it will create the records in the marc field
2982     my ( $record, $biblionumber, $frameworkcode ) = @_;
2983     my $dbh = C4::Context->dbh;
2984     my @fields = $record->fields();
2985     if ( !$frameworkcode ) {
2986         $frameworkcode = "";
2987     }
2988     my $sth =
2989       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
2990     $sth->execute( $frameworkcode, $biblionumber );
2991     $sth->finish;
2992     my $encoding = C4::Context->preference("marcflavour");
2993
2994     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
2995     if ( $encoding eq "UNIMARC" ) {
2996         my $string;
2997         if ( length($record->subfield( 100, "a" )) == 35 ) {
2998             $string = $record->subfield( 100, "a" );
2999             my $f100 = $record->field(100);
3000             $record->delete_field($f100);
3001         }
3002         else {
3003             $string = POSIX::strftime( "%Y%m%d", localtime );
3004             $string =~ s/\-//g;
3005             $string = sprintf( "%-*s", 35, $string );
3006         }
3007         substr( $string, 22, 6, "frey50" );
3008         unless ( $record->subfield( 100, "a" ) ) {
3009             $record->insert_grouped_field(
3010                 MARC::Field->new( 100, "", "", "a" => $string ) );
3011         }
3012     }
3013     my $oldRecord;
3014     if (C4::Context->preference("NoZebra")) {
3015         # only NoZebra indexing needs to have
3016         # the previous version of the record
3017         $oldRecord = GetMarcBiblio($biblionumber);
3018     }
3019     $sth =
3020       $dbh->prepare(
3021         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3022     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
3023         $biblionumber );
3024     $sth->finish;
3025     ModZebra($biblionumber,"specialUpdate","biblioserver",$oldRecord,$record);
3026     return $biblionumber;
3027 }
3028
3029 =head2 z3950_extended_services
3030
3031 z3950_extended_services($serviceType,$serviceOptions,$record);
3032
3033     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.
3034
3035 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3036
3037 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3038
3039     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3040
3041 and maybe
3042
3043     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3044     syntax => the record syntax (transfer syntax)
3045     databaseName = Database from connection object
3046
3047     To set serviceOptions, call set_service_options($serviceType)
3048
3049 C<$record> the record, if one is needed for the service type
3050
3051     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3052
3053 =cut
3054
3055 sub z3950_extended_services {
3056     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3057
3058     # get our connection object
3059     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3060
3061     # create a new package object
3062     my $Zpackage = $Zconn->package();
3063
3064     # set our options
3065     $Zpackage->option( action => $action );
3066
3067     if ( $serviceOptions->{'databaseName'} ) {
3068         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3069     }
3070     if ( $serviceOptions->{'recordIdNumber'} ) {
3071         $Zpackage->option(
3072             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3073     }
3074     if ( $serviceOptions->{'recordIdOpaque'} ) {
3075         $Zpackage->option(
3076             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3077     }
3078
3079  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3080  #if ($serviceType eq 'itemorder') {
3081  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3082  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3083  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3084  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3085  #}
3086
3087     if ( $serviceOptions->{record} ) {
3088         $Zpackage->option( record => $serviceOptions->{record} );
3089
3090         # can be xml or marc
3091         if ( $serviceOptions->{'syntax'} ) {
3092             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3093         }
3094     }
3095
3096     # send the request, handle any exception encountered
3097     eval { $Zpackage->send($serviceType) };
3098     if ( $@ && $@->isa("ZOOM::Exception") ) {
3099         return "error:  " . $@->code() . " " . $@->message() . "\n";
3100     }
3101
3102     # free up package resources
3103     $Zpackage->destroy();
3104 }
3105
3106 =head2 set_service_options
3107
3108 my $serviceOptions = set_service_options($serviceType);
3109
3110 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3111
3112 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3113
3114 =cut
3115
3116 sub set_service_options {
3117     my ($serviceType) = @_;
3118     my $serviceOptions;
3119
3120 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3121 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3122
3123     if ( $serviceType eq 'commit' ) {
3124
3125         # nothing to do
3126     }
3127     if ( $serviceType eq 'create' ) {
3128
3129         # nothing to do
3130     }
3131     if ( $serviceType eq 'drop' ) {
3132         die "ERROR: 'drop' not currently supported (by Zebra)";
3133     }
3134     return $serviceOptions;
3135 }
3136
3137 =head3 get_biblio_authorised_values
3138
3139   find the types and values for all authorised values assigned to this biblio.
3140
3141   parameters:
3142     biblionumber
3143     MARC::Record of the bib
3144
3145   returns: a hashref malling the authorised value to the value set for this biblionumber
3146
3147       $authorised_values = {
3148                              'Scent'     => 'flowery',
3149                              'Audience'  => 'Young Adult',
3150                              'itemtypes' => 'SER',
3151                            };
3152
3153   Notes: forlibrarian should probably be passed in, and called something different.
3154
3155
3156 =cut
3157
3158 sub get_biblio_authorised_values {
3159     my $biblionumber = shift;
3160     my $record       = shift;
3161
3162     my $forlibrarian = 1; # are we in staff or opac?
3163     my $frameworkcode = GetFrameworkCode( $biblionumber );
3164
3165     my $authorised_values;
3166
3167     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3168       or return $authorised_values;
3169
3170     # assume that these entries in the authorised_value table are bibliolevel.
3171     # ones that start with 'item%' are item level.
3172     my $query = q(SELECT distinct authorised_value, kohafield
3173                     FROM marc_subfield_structure
3174                     WHERE authorised_value !=''
3175                       AND (kohafield like 'biblio%'
3176                        OR  kohafield like '') );
3177     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3178
3179     foreach my $tag ( keys( %$tagslib ) ) {
3180         foreach my $subfield ( keys( %{$tagslib->{ $tag }} ) ) {
3181             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3182             if ( 'HASH' eq ref $tagslib->{ $tag }{ $subfield } ) {
3183                 if ( defined $tagslib->{ $tag }{ $subfield }{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } ) {
3184                     if ( defined $record->field( $tag ) ) {
3185                         my $this_subfield_value = $record->field( $tag )->subfield( $subfield );
3186                         if ( defined $this_subfield_value ) {
3187                             $authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } = $this_subfield_value;
3188                         }
3189                     }
3190                 }
3191             }
3192         }
3193     }
3194     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3195     return $authorised_values;
3196 }
3197
3198
3199 1;
3200
3201 __END__
3202
3203 =head1 AUTHOR
3204
3205 Koha Developement team <info@koha.org>
3206
3207 Paul POULAIN paul.poulain@free.fr
3208
3209 Joshua Ferraro jmf@liblime.com
3210
3211 =cut