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