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