C4/Biblio.pm

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