C4/Biblio.pm

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