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