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