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