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