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