C4/Biblio.pm

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