C4/Biblio.pm

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