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