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