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