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