C4/Biblio.pm

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