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