C4/Biblio.pm

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