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