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