C4/Biblio.pm

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