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