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