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