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