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