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