C4/Biblio.pm

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