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                         #---- class_sources
2276                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "cn_source" ) {
2277                         push @authorised_values, "" unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2278
2279                         my $class_sources = GetClassSources();
2280                         my $default_source = C4::Context->preference("DefaultClassificationSource");
2281
2282                         foreach my $class_source (sort keys %$class_sources) {
2283                             next unless $class_sources->{$class_source}->{'used'} or
2284                                         ($class_source eq $default_source);
2285                             push @authorised_values, $class_source;
2286                             $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
2287                         }
2288
2289                         #---- "true" authorised value
2290                     } else {
2291                         $authorised_values_sth->execute( $tagslib->{$tag}->{$subfield}->{authorised_value} );
2292                         push @authorised_values, ""
2293                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2294                         while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
2295                             push @authorised_values, $value;
2296                             $authorised_lib{$value} = $lib;
2297                         }
2298                     }
2299                     $subfield_data{marc_value} = CGI::scrolling_list(
2300                         -name     => 'field_value',
2301                         -values   => \@authorised_values,
2302                         -default  => "$defaultvalue",
2303                         -labels   => \%authorised_lib,
2304                         -size     => 1,
2305                         -tabindex => '',
2306                         -multiple => 0,
2307                     );
2308                 } else {
2309                     $subfield_data{marc_value} = "<input type=\"text\" name=\"field_value\" value=\"$defaultvalue\" size=\"50\" maxlength=\"255\" />";
2310                 }
2311                 push( @loop_data, \%subfield_data );
2312             }
2313         }
2314     }
2315     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2316       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2317     return {
2318         'itemtagfield'    => $itemtagfield,
2319         'itemtagsubfield' => $itemtagsubfield,
2320         'itemnumber'      => $itemnumber,
2321         'iteminformation' => \@loop_data
2322     };
2323 }
2324
2325 #"
2326
2327 #
2328 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2329 # at the same time
2330 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2331 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2332 # =head2 ModZebrafiles
2333 #
2334 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2335 #
2336 # =cut
2337 #
2338 # sub ModZebrafiles {
2339 #
2340 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2341 #
2342 #     my $op;
2343 #     my $zebradir =
2344 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2345 #     unless ( opendir( DIR, "$zebradir" ) ) {
2346 #         warn "$zebradir not found";
2347 #         return;
2348 #     }
2349 #     closedir DIR;
2350 #     my $filename = $zebradir . $biblionumber;
2351 #
2352 #     if ($record) {
2353 #         open( OUTPUT, ">", $filename . ".xml" );
2354 #         print OUTPUT $record;
2355 #         close OUTPUT;
2356 #     }
2357 # }
2358
2359 =head2 ModZebra
2360
2361   ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2362
2363 $biblionumber is the biblionumber we want to index
2364
2365 $op is specialUpdate or delete, and is used to know what we want to do
2366
2367 $server is the server that we want to update
2368
2369 $oldRecord is the MARC::Record containing the previous version of the record.  This is used only when
2370 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2371 do an update.
2372
2373 $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.
2374
2375 =cut
2376
2377 sub ModZebra {
2378 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2379     my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2380     my $dbh = C4::Context->dbh;
2381
2382     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2383     # at the same time
2384     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2385     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2386
2387     if ( C4::Context->preference("NoZebra") ) {
2388
2389         # lock the nozebra table : we will read index lines, update them in Perl process
2390         # and write everything in 1 transaction.
2391         # lock the table to avoid someone else overwriting what we are doing
2392         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2393         my %result;    # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2394         if ( $op eq 'specialUpdate' ) {
2395
2396             # OK, we have to add or update the record
2397             # 1st delete (virtually, in indexes), if record actually exists
2398             if ($oldRecord) {
2399                 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2400             }
2401
2402             # ... add the record
2403             %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2404         } else {
2405
2406             # it's a deletion, delete the record...
2407             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2408             %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2409         }
2410
2411         # ok, now update the database...
2412         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2413         foreach my $key ( keys %result ) {
2414             foreach my $index ( keys %{ $result{$key} } ) {
2415                 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2416             }
2417         }
2418         $dbh->do('UNLOCK TABLES');
2419     } else {
2420
2421         #
2422         # we use zebra, just fill zebraqueue table
2423         #
2424         my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2425                          WHERE server = ?
2426                          AND   biblio_auth_number = ?
2427                          AND   operation = ?
2428                          AND   done = 0";
2429         my $check_sth = $dbh->prepare_cached($check_sql);
2430         $check_sth->execute( $server, $biblionumber, $op );
2431         my ($count) = $check_sth->fetchrow_array;
2432         $check_sth->finish();
2433         if ( $count == 0 ) {
2434             my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2435             $sth->execute( $biblionumber, $server, $op );
2436             $sth->finish;
2437         }
2438     }
2439 }
2440
2441 =head2 GetNoZebraIndexes
2442
2443   %indexes = GetNoZebraIndexes;
2444
2445 return the data from NoZebraIndexes syspref.
2446
2447 =cut
2448
2449 sub GetNoZebraIndexes {
2450     my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2451     my %indexes;
2452   INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2453         $line =~ /(.*)=>(.*)/;
2454         my $index  = $1;    # initial ' or " is removed afterwards
2455         my $fields = $2;
2456         $index  =~ s/'|"|\s//g;
2457         $fields =~ s/'|"|\s//g;
2458         $indexes{$index} = $fields;
2459     }
2460     return %indexes;
2461 }
2462
2463 =head1 INTERNAL FUNCTIONS
2464
2465 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2466
2467 function to delete a biblio in NoZebra indexes
2468 This function does NOT delete anything in database : it reads all the indexes entries
2469 that have to be deleted & delete them in the hash
2470
2471 The SQL part is done either :
2472  - after the Add if we are modifying a biblio (delete + add again)
2473  - immediatly after this sub if we are doing a true deletion.
2474
2475 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2476
2477 =cut
2478
2479 sub _DelBiblioNoZebra {
2480     my ( $biblionumber, $record, $server ) = @_;
2481
2482     # Get the indexes
2483     my $dbh = C4::Context->dbh;
2484
2485     # Get the indexes
2486     my %index;
2487     my $title;
2488     if ( $server eq 'biblioserver' ) {
2489         %index = GetNoZebraIndexes;
2490
2491         # get title of the record (to store the 10 first letters with the index)
2492         my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' );    # FIXME: should be GetFrameworkCode($biblionumber) ??
2493         $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2494     } else {
2495
2496         # for authorities, the "title" is the $a mainentry
2497         my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2498         my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2499         warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2500         $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2501         $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2502         $index{'mainentry'}     = $authref->{'auth_tag_to_report'} . '*';
2503         $index{'auth_type'}     = "${auth_type_tag}${auth_type_sf}";
2504     }
2505
2506     my %result;
2507
2508     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2509     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2510
2511     # limit to 10 char, should be enough, and limit the DB size
2512     $title = substr( $title, 0, 10 );
2513
2514     #parse each field
2515     my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2516     foreach my $field ( $record->fields() ) {
2517
2518         #parse each subfield
2519         next if $field->tag < 10;
2520         foreach my $subfield ( $field->subfields() ) {
2521             my $tag          = $field->tag();
2522             my $subfieldcode = $subfield->[0];
2523             my $indexed      = 0;
2524
2525             # check each index to see if the subfield is stored somewhere
2526             # otherwise, store it in __RAW__ index
2527             foreach my $key ( keys %index ) {
2528
2529                 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2530                 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2531                     $indexed = 1;
2532                     my $line = lc $subfield->[1];
2533
2534                     # remove meaningless value in the field...
2535                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2536
2537                     # ... and split in words
2538                     foreach ( split / /, $line ) {
2539                         next unless $_;    # skip  empty values (multiple spaces)
2540                                            # if the entry is already here, do nothing, the biblionumber has already be removed
2541                         unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2542
2543                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2544                             $sth2->execute( $server, $key, $_ );
2545                             my $existing_biblionumbers = $sth2->fetchrow;
2546
2547                             # it exists
2548                             if ($existing_biblionumbers) {
2549
2550                                 #                                 warn " existing for $key $_: $existing_biblionumbers";
2551                                 $result{$key}->{$_} = $existing_biblionumbers;
2552                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2553                             }
2554                         }
2555                     }
2556                 }
2557             }
2558
2559             # the subfield is not indexed, store it in __RAW__ index anyway
2560             unless ($indexed) {
2561                 my $line = lc $subfield->[1];
2562                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2563
2564                 # ... and split in words
2565                 foreach ( split / /, $line ) {
2566                     next unless $_;    # skip  empty values (multiple spaces)
2567                                        # if the entry is already here, do nothing, the biblionumber has already be removed
2568                     unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
2569
2570                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2571                         $sth2->execute( $server, '__RAW__', $_ );
2572                         my $existing_biblionumbers = $sth2->fetchrow;
2573
2574                         # it exists
2575                         if ($existing_biblionumbers) {
2576                             $result{'__RAW__'}->{$_} = $existing_biblionumbers;
2577                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2578                         }
2579                     }
2580                 }
2581             }
2582         }
2583     }
2584     return %result;
2585 }
2586
2587 =head2 _AddBiblioNoZebra
2588
2589   _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2590
2591 function to add a biblio in NoZebra indexes
2592
2593 =cut
2594
2595 sub _AddBiblioNoZebra {
2596     my ( $biblionumber, $record, $server, %result ) = @_;
2597     my $dbh = C4::Context->dbh;
2598
2599     # Get the indexes
2600     my %index;
2601     my $title;
2602     if ( $server eq 'biblioserver' ) {
2603         %index = GetNoZebraIndexes;
2604
2605         # get title of the record (to store the 10 first letters with the index)
2606         my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' );    # FIXME: should be GetFrameworkCode($biblionumber) ??
2607         $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2608     } else {
2609
2610         # warn "server : $server";
2611         # for authorities, the "title" is the $a mainentry
2612         my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2613         my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2614         warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2615         $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2616         $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
2617         $index{'mainentry'}     = $authref->{auth_tag_to_report} . '*';
2618         $index{'auth_type'}     = "${auth_type_tag}${auth_type_sf}";
2619     }
2620
2621     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2622     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
2623
2624     # limit to 10 char, should be enough, and limit the DB size
2625     $title = substr( $title, 0, 10 );
2626
2627     #parse each field
2628     my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2629     foreach my $field ( $record->fields() ) {
2630
2631         #parse each subfield
2632         ###FIXME: impossible to index a 001-009 value with NoZebra
2633         next if $field->tag < 10;
2634         foreach my $subfield ( $field->subfields() ) {
2635             my $tag          = $field->tag();
2636             my $subfieldcode = $subfield->[0];
2637             my $indexed      = 0;
2638
2639             #             warn "INDEXING :".$subfield->[1];
2640             # check each index to see if the subfield is stored somewhere
2641             # otherwise, store it in __RAW__ index
2642             foreach my $key ( keys %index ) {
2643
2644                 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2645                 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2646                     $indexed = 1;
2647                     my $line = lc $subfield->[1];
2648
2649                     # remove meaningless value in the field...
2650                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2651
2652                     # ... and split in words
2653                     foreach ( split / /, $line ) {
2654                         next unless $_;    # skip  empty values (multiple spaces)
2655                                            # if the entry is already here, improve weight
2656
2657                         #                         warn "managing $_";
2658                         if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2659                             my $weight = $1 + 1;
2660                             $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2661                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2662                         } else {
2663
2664                             # get the value if it exist in the nozebra table, otherwise, create it
2665                             $sth2->execute( $server, $key, $_ );
2666                             my $existing_biblionumbers = $sth2->fetchrow;
2667
2668                             # it exists
2669                             if ($existing_biblionumbers) {
2670                                 $result{$key}->{"$_"} = $existing_biblionumbers;
2671                                 my $weight = defined $1 ? $1 + 1 : 1;
2672                                 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2673                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2674
2675                                 # create a new ligne for this entry
2676                             } else {
2677
2678                                 #                             warn "INSERT : $server / $key / $_";
2679                                 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
2680                                 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
2681                             }
2682                         }
2683                     }
2684                 }
2685             }
2686
2687             # the subfield is not indexed, store it in __RAW__ index anyway
2688             unless ($indexed) {
2689                 my $line = lc $subfield->[1];
2690                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2691
2692                 # ... and split in words
2693                 foreach ( split / /, $line ) {
2694                     next unless $_;    # skip  empty values (multiple spaces)
2695                                        # if the entry is already here, improve weight
2696                     my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
2697                     if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2698                         my $weight = $1 + 1;
2699                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2700                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2701                     } else {
2702
2703                         # get the value if it exist in the nozebra table, otherwise, create it
2704                         $sth2->execute( $server, '__RAW__', $_ );
2705                         my $existing_biblionumbers = $sth2->fetchrow;
2706
2707                         # it exists
2708                         if ($existing_biblionumbers) {
2709                             $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
2710                             my $weight = ( $1 ? $1 : 0 ) + 1;
2711                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2712                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2713
2714                             # create a new ligne for this entry
2715                         } else {
2716                             $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ',  indexname="__RAW__",value=' . $dbh->quote($_) );
2717                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
2718                         }
2719                     }
2720                 }
2721             }
2722         }
2723     }
2724     return %result;
2725 }
2726
2727 =head2 _find_value
2728
2729   ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2730
2731 Find the given $subfield in the given $tag in the given
2732 MARC::Record $record.  If the subfield is found, returns
2733 the (indicators, value) pair; otherwise, (undef, undef) is
2734 returned.
2735
2736 PROPOSITION :
2737 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2738 I suggest we export it from this module.
2739
2740 =cut
2741
2742 sub _find_value {
2743     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2744     my @result;
2745     my $indicator;
2746     if ( $tagfield < 10 ) {
2747         if ( $record->field($tagfield) ) {
2748             push @result, $record->field($tagfield)->data();
2749         } else {
2750             push @result, "";
2751         }
2752     } else {
2753         foreach my $field ( $record->field($tagfield) ) {
2754             my @subfields = $field->subfields();
2755             foreach my $subfield (@subfields) {
2756                 if ( @$subfield[0] eq $insubfield ) {
2757                     push @result, @$subfield[1];
2758                     $indicator = $field->indicator(1) . $field->indicator(2);
2759                 }
2760             }
2761         }
2762     }
2763     return ( $indicator, @result );
2764 }
2765
2766 =head2 _koha_marc_update_bib_ids
2767
2768
2769   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2770
2771 Internal function to add or update biblionumber and biblioitemnumber to
2772 the MARC XML.
2773
2774 =cut
2775
2776 sub _koha_marc_update_bib_ids {
2777     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2778
2779     # we must add bibnum and bibitemnum in MARC::Record...
2780     # we build the new field with biblionumber and biblioitemnumber
2781     # we drop the original field
2782     # we add the new builded field.
2783     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
2784     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
2785
2786     if ( $biblio_tag != $biblioitem_tag ) {
2787
2788         # biblionumber & biblioitemnumber are in different fields
2789
2790         # deal with biblionumber
2791         my ( $new_field, $old_field );
2792         if ( $biblio_tag < 10 ) {
2793             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
2794         } else {
2795             $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
2796         }
2797
2798         # drop old field and create new one...
2799         $old_field = $record->field($biblio_tag);
2800         $record->delete_field($old_field) if $old_field;
2801         $record->append_fields($new_field);
2802
2803         # deal with biblioitemnumber
2804         if ( $biblioitem_tag < 10 ) {
2805             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
2806         } else {
2807             $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
2808         }
2809
2810         # drop old field and create new one...
2811         $old_field = $record->field($biblioitem_tag);
2812         $record->delete_field($old_field) if $old_field;
2813         $record->insert_fields_ordered($new_field);
2814
2815     } else {
2816
2817         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
2818         my $new_field = MARC::Field->new(
2819             $biblio_tag, '', '',
2820             "$biblio_subfield"     => $biblionumber,
2821             "$biblioitem_subfield" => $biblioitemnumber
2822         );
2823
2824         # drop old field and create new one...
2825         my $old_field = $record->field($biblio_tag);
2826         $record->delete_field($old_field) if $old_field;
2827         $record->insert_fields_ordered($new_field);
2828     }
2829 }
2830
2831 =head2 _koha_marc_update_biblioitem_cn_sort
2832
2833   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2834
2835 Given a MARC bib record and the biblioitem hash, update the
2836 subfield that contains a copy of the value of biblioitems.cn_sort.
2837
2838 =cut
2839
2840 sub _koha_marc_update_biblioitem_cn_sort {
2841     my $marc          = shift;
2842     my $biblioitem    = shift;
2843     my $frameworkcode = shift;
2844
2845     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
2846     return unless $biblioitem_tag;
2847
2848     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2849
2850     if ( my $field = $marc->field($biblioitem_tag) ) {
2851         $field->delete_subfield( code => $biblioitem_subfield );
2852         if ( $cn_sort ne '' ) {
2853             $field->add_subfields( $biblioitem_subfield => $cn_sort );
2854         }
2855     } else {
2856
2857         # if we get here, no biblioitem tag is present in the MARC record, so
2858         # we'll create it if $cn_sort is not empty -- this would be
2859         # an odd combination of events, however
2860         if ($cn_sort) {
2861             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2862         }
2863     }
2864 }
2865
2866 =head2 _koha_add_biblio
2867
2868   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2869
2870 Internal function to add a biblio ($biblio is a hash with the values)
2871
2872 =cut
2873
2874 sub _koha_add_biblio {
2875     my ( $dbh, $biblio, $frameworkcode ) = @_;
2876
2877     my $error;
2878
2879     # set the series flag
2880     unless (defined $biblio->{'serial'}){
2881         $biblio->{'serial'} = 0;
2882         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
2883     }
2884
2885     my $query = "INSERT INTO biblio
2886         SET frameworkcode = ?,
2887             author = ?,
2888             title = ?,
2889             unititle =?,
2890             notes = ?,
2891             serial = ?,
2892             seriestitle = ?,
2893             copyrightdate = ?,
2894             datecreated=NOW(),
2895             abstract = ?
2896         ";
2897     my $sth = $dbh->prepare($query);
2898     $sth->execute(
2899         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
2900         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
2901     );
2902
2903     my $biblionumber = $dbh->{'mysql_insertid'};
2904     if ( $dbh->errstr ) {
2905         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
2906         warn $error;
2907     }
2908
2909     $sth->finish();
2910
2911     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2912     return ( $biblionumber, $error );
2913 }
2914
2915 =head2 _koha_modify_biblio
2916
2917   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2918
2919 Internal function for updating the biblio table
2920
2921 =cut
2922
2923 sub _koha_modify_biblio {
2924     my ( $dbh, $biblio, $frameworkcode ) = @_;
2925     my $error;
2926
2927     my $query = "
2928         UPDATE biblio
2929         SET    frameworkcode = ?,
2930                author = ?,
2931                title = ?,
2932                unititle = ?,
2933                notes = ?,
2934                serial = ?,
2935                seriestitle = ?,
2936                copyrightdate = ?,
2937                abstract = ?
2938         WHERE  biblionumber = ?
2939         "
2940       ;
2941     my $sth = $dbh->prepare($query);
2942
2943     $sth->execute(
2944         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
2945         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
2946     ) if $biblio->{'biblionumber'};
2947
2948     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2949         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2950         warn $error;
2951     }
2952     return ( $biblio->{'biblionumber'}, $error );
2953 }
2954
2955 =head2 _koha_modify_biblioitem_nonmarc
2956
2957   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2958
2959 Updates biblioitems row except for marc and marcxml, which should be changed
2960 via ModBiblioMarc
2961
2962 =cut
2963
2964 sub _koha_modify_biblioitem_nonmarc {
2965     my ( $dbh, $biblioitem ) = @_;
2966     my $error;
2967
2968     # re-calculate the cn_sort, it may have changed
2969     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2970
2971     my $query = "UPDATE biblioitems
2972     SET biblionumber    = ?,
2973         volume          = ?,
2974         number          = ?,
2975         itemtype        = ?,
2976         isbn            = ?,
2977         issn            = ?,
2978         publicationyear = ?,
2979         publishercode   = ?,
2980         volumedate      = ?,
2981         volumedesc      = ?,
2982         collectiontitle = ?,
2983         collectionissn  = ?,
2984         collectionvolume= ?,
2985         editionstatement= ?,
2986         editionresponsibility = ?,
2987         illus           = ?,
2988         pages           = ?,
2989         notes           = ?,
2990         size            = ?,
2991         place           = ?,
2992         lccn            = ?,
2993         url             = ?,
2994         cn_source       = ?,
2995         cn_class        = ?,
2996         cn_item         = ?,
2997         cn_suffix       = ?,
2998         cn_sort         = ?,
2999         totalissues     = ?
3000         where biblioitemnumber = ?
3001         ";
3002     my $sth = $dbh->prepare($query);
3003     $sth->execute(
3004         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3005         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3006         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3007         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3008         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3009         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3010         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3011         $biblioitem->{'biblioitemnumber'}
3012     );
3013     if ( $dbh->errstr ) {
3014         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3015         warn $error;
3016     }
3017     return ( $biblioitem->{'biblioitemnumber'}, $error );
3018 }
3019
3020 =head2 _koha_add_biblioitem
3021
3022   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3023
3024 Internal function to add a biblioitem
3025
3026 =cut
3027
3028 sub _koha_add_biblioitem {
3029     my ( $dbh, $biblioitem ) = @_;
3030     my $error;
3031
3032     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3033     my $query = "INSERT INTO biblioitems SET
3034         biblionumber    = ?,
3035         volume          = ?,
3036         number          = ?,
3037         itemtype        = ?,
3038         isbn            = ?,
3039         issn            = ?,
3040         publicationyear = ?,
3041         publishercode   = ?,
3042         volumedate      = ?,
3043         volumedesc      = ?,
3044         collectiontitle = ?,
3045         collectionissn  = ?,
3046         collectionvolume= ?,
3047         editionstatement= ?,
3048         editionresponsibility = ?,
3049         illus           = ?,
3050         pages           = ?,
3051         notes           = ?,
3052         size            = ?,
3053         place           = ?,
3054         lccn            = ?,
3055         marc            = ?,
3056         url             = ?,
3057         cn_source       = ?,
3058         cn_class        = ?,
3059         cn_item         = ?,
3060         cn_suffix       = ?,
3061         cn_sort         = ?,
3062         totalissues     = ?
3063         ";
3064     my $sth = $dbh->prepare($query);
3065     $sth->execute(
3066         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3067         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3068         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3069         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3070         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3071         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3072         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3073         $biblioitem->{'totalissues'}
3074     );
3075     my $bibitemnum = $dbh->{'mysql_insertid'};
3076
3077     if ( $dbh->errstr ) {
3078         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3079         warn $error;
3080     }
3081     $sth->finish();
3082     return ( $bibitemnum, $error );
3083 }
3084
3085 =head2 _koha_delete_biblio
3086
3087   $error = _koha_delete_biblio($dbh,$biblionumber);
3088
3089 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3090
3091 C<$dbh> - the database handle
3092
3093 C<$biblionumber> - the biblionumber of the biblio to be deleted
3094
3095 =cut
3096
3097 # FIXME: add error handling
3098
3099 sub _koha_delete_biblio {
3100     my ( $dbh, $biblionumber ) = @_;
3101
3102     # get all the data for this biblio
3103     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3104     $sth->execute($biblionumber);
3105
3106     if ( my $data = $sth->fetchrow_hashref ) {
3107
3108         # save the record in deletedbiblio
3109         # find the fields to save
3110         my $query = "INSERT INTO deletedbiblio SET ";
3111         my @bind  = ();
3112         foreach my $temp ( keys %$data ) {
3113             $query .= "$temp = ?,";
3114             push( @bind, $data->{$temp} );
3115         }
3116
3117         # replace the last , by ",?)"
3118         $query =~ s/\,$//;
3119         my $bkup_sth = $dbh->prepare($query);
3120         $bkup_sth->execute(@bind);
3121         $bkup_sth->finish;
3122
3123         # delete the biblio
3124         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3125         $del_sth->execute($biblionumber);
3126         $del_sth->finish;
3127     }
3128     $sth->finish;
3129     return undef;
3130 }
3131
3132 =head2 _koha_delete_biblioitems
3133
3134   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3135
3136 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3137
3138 C<$dbh> - the database handle
3139 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3140
3141 =cut
3142
3143 # FIXME: add error handling
3144
3145 sub _koha_delete_biblioitems {
3146     my ( $dbh, $biblioitemnumber ) = @_;
3147
3148     # get all the data for this biblioitem
3149     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3150     $sth->execute($biblioitemnumber);
3151
3152     if ( my $data = $sth->fetchrow_hashref ) {
3153
3154         # save the record in deletedbiblioitems
3155         # find the fields to save
3156         my $query = "INSERT INTO deletedbiblioitems SET ";
3157         my @bind  = ();
3158         foreach my $temp ( keys %$data ) {
3159             $query .= "$temp = ?,";
3160             push( @bind, $data->{$temp} );
3161         }
3162
3163         # replace the last , by ",?)"
3164         $query =~ s/\,$//;
3165         my $bkup_sth = $dbh->prepare($query);
3166         $bkup_sth->execute(@bind);
3167         $bkup_sth->finish;
3168
3169         # delete the biblioitem
3170         my $del_sth = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3171         $del_sth->execute($biblioitemnumber);
3172         $del_sth->finish;
3173     }
3174     $sth->finish;
3175     return undef;
3176 }
3177
3178 =head1 UNEXPORTED FUNCTIONS
3179
3180 =head2 ModBiblioMarc
3181
3182   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3183
3184 Add MARC data for a biblio to koha
3185
3186 Function exported, but should NOT be used, unless you really know what you're doing
3187
3188 =cut
3189
3190 sub ModBiblioMarc {
3191
3192     # pass the MARC::Record to this function, and it will create the records in the marc field
3193     my ( $record, $biblionumber, $frameworkcode ) = @_;
3194     my $dbh    = C4::Context->dbh;
3195     my @fields = $record->fields();
3196     if ( !$frameworkcode ) {
3197         $frameworkcode = "";
3198     }
3199     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3200     $sth->execute( $frameworkcode, $biblionumber );
3201     $sth->finish;
3202     my $encoding = C4::Context->preference("marcflavour");
3203
3204     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3205     if ( $encoding eq "UNIMARC" ) {
3206         my $string = $record->subfield( 100, "a" );
3207         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3208             my $f100 = $record->field(100);
3209             $record->delete_field($f100);
3210         } else {
3211             $string = POSIX::strftime( "%Y%m%d", localtime );
3212             $string =~ s/\-//g;
3213             $string = sprintf( "%-*s", 35, $string );
3214         }
3215         substr( $string, 22, 6, "frey50" );
3216         unless ( $record->subfield( 100, "a" ) ) {
3217             $record->insert_grouped_field( MARC::Field->new( 100, "", "", "a" => $string ) );
3218         }
3219     }
3220     my $oldRecord;
3221     if ( C4::Context->preference("NoZebra") ) {
3222
3223         # only NoZebra indexing needs to have
3224         # the previous version of the record
3225         $oldRecord = GetMarcBiblio($biblionumber);
3226     }
3227     $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3228     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3229     $sth->finish;
3230     ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3231     return $biblionumber;
3232 }
3233
3234 =head2 z3950_extended_services
3235
3236   z3950_extended_services($serviceType,$serviceOptions,$record);
3237
3238 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.
3239
3240 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3241
3242 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3243
3244  action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3245
3246 and maybe
3247
3248   recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3249   syntax => the record syntax (transfer syntax)
3250   databaseName = Database from connection object
3251
3252 To set serviceOptions, call set_service_options($serviceType)
3253
3254 C<$record> the record, if one is needed for the service type
3255
3256 A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3257
3258 =cut
3259
3260 sub z3950_extended_services {
3261     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3262
3263     # get our connection object
3264     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3265
3266     # create a new package object
3267     my $Zpackage = $Zconn->package();
3268
3269     # set our options
3270     $Zpackage->option( action => $action );
3271
3272     if ( $serviceOptions->{'databaseName'} ) {
3273         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3274     }
3275     if ( $serviceOptions->{'recordIdNumber'} ) {
3276         $Zpackage->option( recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3277     }
3278     if ( $serviceOptions->{'recordIdOpaque'} ) {
3279         $Zpackage->option( recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3280     }
3281
3282     # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3283     #if ($serviceType eq 'itemorder') {
3284     #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3285     #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3286     #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3287     #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3288     #}
3289
3290     if ( $serviceOptions->{record} ) {
3291         $Zpackage->option( record => $serviceOptions->{record} );
3292
3293         # can be xml or marc
3294         if ( $serviceOptions->{'syntax'} ) {
3295             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3296         }
3297     }
3298
3299     # send the request, handle any exception encountered
3300     eval { $Zpackage->send($serviceType) };
3301     if ( $@ && $@->isa("ZOOM::Exception") ) {
3302         return "error:  " . $@->code() . " " . $@->message() . "\n";
3303     }
3304
3305     # free up package resources
3306     $Zpackage->destroy();
3307 }
3308
3309 =head2 set_service_options
3310
3311   my $serviceOptions = set_service_options($serviceType);
3312
3313 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3314
3315 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3316
3317 =cut
3318
3319 sub set_service_options {
3320     my ($serviceType) = @_;
3321     my $serviceOptions;
3322
3323     # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3324     #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3325
3326     if ( $serviceType eq 'commit' ) {
3327
3328         # nothing to do
3329     }
3330     if ( $serviceType eq 'create' ) {
3331
3332         # nothing to do
3333     }
3334     if ( $serviceType eq 'drop' ) {
3335         die "ERROR: 'drop' not currently supported (by Zebra)";
3336     }
3337     return $serviceOptions;
3338 }
3339
3340 =head2 get_biblio_authorised_values
3341
3342 find the types and values for all authorised values assigned to this biblio.
3343
3344 parameters:
3345     biblionumber
3346     MARC::Record of the bib
3347
3348 returns: a hashref mapping the authorised value to the value set for this biblionumber
3349
3350   $authorised_values = {
3351                        'Scent'     => 'flowery',
3352                        'Audience'  => 'Young Adult',
3353                        'itemtypes' => 'SER',
3354                         };
3355
3356 Notes: forlibrarian should probably be passed in, and called something different.
3357
3358 =cut
3359
3360 sub get_biblio_authorised_values {
3361     my $biblionumber = shift;
3362     my $record       = shift;
3363
3364     my $forlibrarian  = 1;                                 # are we in staff or opac?
3365     my $frameworkcode = GetFrameworkCode($biblionumber);
3366
3367     my $authorised_values;
3368
3369     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3370       or return $authorised_values;
3371
3372     # assume that these entries in the authorised_value table are bibliolevel.
3373     # ones that start with 'item%' are item level.
3374     my $query = q(SELECT distinct authorised_value, kohafield
3375                     FROM marc_subfield_structure
3376                     WHERE authorised_value !=''
3377                       AND (kohafield like 'biblio%'
3378                        OR  kohafield like '') );
3379     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3380
3381     foreach my $tag ( keys(%$tagslib) ) {
3382         foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3383
3384             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3385             if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3386                 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3387                     if ( defined $record->field($tag) ) {
3388                         my $this_subfield_value = $record->field($tag)->subfield($subfield);
3389                         if ( defined $this_subfield_value ) {
3390                             $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3391                         }
3392                     }
3393                 }
3394             }
3395         }
3396     }
3397
3398     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3399     return $authorised_values;
3400 }
3401
3402 1;
3403
3404 __END__
3405
3406 =head1 AUTHOR
3407
3408 Koha Development Team <http://koha-community.org/>
3409
3410 Paul POULAIN paul.poulain@free.fr
3411
3412 Joshua Ferraro jmf@liblime.com
3413
3414 =cut