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