C4/Biblio.pm

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