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