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