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