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