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