C4/Biblio.pm

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