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