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