C4/Biblio.pm

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