C4/Biblio.pm

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