C4/Biblio.pm

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