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