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