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