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