C4/Biblio.pm

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