C4/Biblio.pm

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