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