koha-dev.rot13.org Git - srvgit/blob - 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 $biblio = Koha::Biblios->find($biblionumber);
 368         logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $biblio->metadata->record->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 $biblio = Koha::Biblios->find($hostbiblionumber);
1953     my $hostrecord = $biblio->metadata->record;
1954     my $item = Koha::Items->find($hostitemnumber);
1955
1956         my $hostmarcfield;
1957     if ( $marcflavour eq "MARC21" ) {
1958
1959         #main entry
1960         my $mainentry;
1961         if ($hostrecord->subfield('100','a')){
1962             $mainentry = $hostrecord->subfield('100','a');
1963         } elsif ($hostrecord->subfield('110','a')){
1964             $mainentry = $hostrecord->subfield('110','a');
1965         } else {
1966             $mainentry = $hostrecord->subfield('111','a');
1967         }
1968
1969         # qualification info
1970         my $qualinfo;
1971         if (my $field260 = $hostrecord->field('260')){
1972             $qualinfo =  $field260->as_string( 'abc' );
1973         }
1974
1975
1976         #other fields
1977         my $ed = $hostrecord->subfield('250','a');
1978         my $barcode = $item->barcode;
1979         my $title = $hostrecord->subfield('245','a');
1980
1981         # record control number, 001 with 003 and prefix
1982         my $recctrlno;
1983         if ($hostrecord->field('001')){
1984             $recctrlno = $hostrecord->field('001')->data();
1985             if ($hostrecord->field('003')){
1986                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
1987             }
1988         }
1989
1990         # issn/isbn
1991         my $issn = $hostrecord->subfield('022','a');
1992         my $isbn = $hostrecord->subfield('020','a');
1993
1994
1995         $hostmarcfield = MARC::Field->new(
1996                 773, '0', '',
1997                 '0' => $hostbiblionumber,
1998                 '9' => $hostitemnumber,
1999                 'a' => $mainentry,
2000                 'b' => $ed,
2001                 'd' => $qualinfo,
2002                 'o' => $barcode,
2003                 't' => $title,
2004                 'w' => $recctrlno,
2005                 'x' => $issn,
2006                 'z' => $isbn
2007                 );
2008     } elsif ($marcflavour eq "UNIMARC") {
2009         $hostmarcfield = MARC::Field->new(
2010             461, '', '',
2011             '0' => $hostbiblionumber,
2012             't' => $hostrecord->subfield('200','a'),
2013             '9' => $hostitemnumber
2014         );
2015     };
2016
2017     return $hostmarcfield;
2018 }
2019
2020 =head2 TransformHtmlToXml
2021
2022   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2023                              $ind_tag, $auth_type )
2024
2025 $auth_type contains :
2026
2027 =over
2028
2029 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2030
2031 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2032
2033 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2034
2035 =back
2036
2037 =cut
2038
2039 sub TransformHtmlToXml {
2040     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2041     # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2042
2043     my ( $perm_loc_tag, $perm_loc_subfield ) = C4::Biblio::GetMarcFromKohaField( "items.permanent_location" );
2044
2045     my $xml = MARC::File::XML::header('UTF-8');
2046     $xml .= "<record>\n";
2047     $auth_type = C4::Context->preference('marcflavour') unless $auth_type; # FIXME auth_type must be removed
2048     MARC::File::XML->default_record_format($auth_type);
2049
2050     # in UNIMARC, field 100 contains the encoding
2051     # check that there is one, otherwise the
2052     # MARC::Record->new_from_xml will fail (and Koha will die)
2053     my $unimarc_and_100_exist = 0;
2054     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
2055     my $prevtag = -1;
2056     my $first   = 1;
2057     my $j       = -1;
2058     my $close_last_tag;
2059     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2060         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2061
2062             # if we have a 100 field and it's values are not correct, skip them.
2063             # if we don't have any valid 100 field, we will create a default one at the end
2064             my $enc = substr( @$values[$i], 26, 2 );
2065             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2066                 $unimarc_and_100_exist = 1;
2067             } else {
2068                 next;
2069             }
2070         }
2071         @$values[$i] =~ s/&/&amp;/g;
2072         @$values[$i] =~ s/</&lt;/g;
2073         @$values[$i] =~ s/>/&gt;/g;
2074         @$values[$i] =~ s/"/&quot;/g;
2075         @$values[$i] =~ s/'/&apos;/g;
2076
2077         my $skip = @$values[$i] eq q{};
2078         $skip = 0
2079           if $perm_loc_tag
2080           && $perm_loc_subfield
2081           && @$tags[$i] eq $perm_loc_tag
2082           && @$subfields[$i] eq $perm_loc_subfield;
2083
2084         if ( ( @$tags[$i] ne $prevtag ) ) {
2085             $close_last_tag = 0;
2086             $j++ unless ( @$tags[$i] eq "" );
2087             my $str = ( $indicator->[$j] // q{} ) . '  '; # extra space prevents substr outside of string warn
2088             my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2089             my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2090             if ( !$first ) {
2091                 $xml .= "</datafield>\n";
2092                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2093                     && ( !$skip ) ) {
2094                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2095                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2096                     $first = 0;
2097                     $close_last_tag = 1;
2098                 } else {
2099                     $first = 1;
2100                 }
2101             } else {
2102                 if ( !$skip ) {
2103
2104                     # leader
2105                     if ( @$tags[$i] eq "000" ) {
2106                         $xml .= "<leader>@$values[$i]</leader>\n";
2107                         $first = 1;
2108
2109                         # rest of the fixed fields
2110                     } elsif ( @$tags[$i] < 10 ) {
2111                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2112                         $first = 1;
2113                     } else {
2114                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2115                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2116                         $first = 0;
2117                         $close_last_tag = 1;
2118                     }
2119                 }
2120             }
2121         } else {    # @$tags[$i] eq $prevtag
2122             if ( !$skip ) {
2123                 if ($first) {
2124                     my $str = ( $indicator->[$j] // q{} ) . '  '; # extra space prevents substr outside of string warn
2125                     my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2126                     my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2127                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2128                     $first = 0;
2129                     $close_last_tag = 1;
2130                 }
2131                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2132             }
2133         }
2134         $prevtag = @$tags[$i];
2135     }
2136     $xml .= "</datafield>\n" if $close_last_tag;
2137     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2138
2139         #     warn "SETTING 100 for $auth_type";
2140         my $string = strftime( "%Y%m%d", localtime(time) );
2141
2142         # set 50 to position 26 is biblios, 13 if authorities
2143         my $pos = 26;
2144         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2145         $string = sprintf( "%-*s", 35, $string );
2146         substr( $string, $pos, 6, "50" );
2147         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2148         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2149         $xml .= "</datafield>\n";
2150     }
2151     $xml .= "</record>\n";
2152     $xml .= MARC::File::XML::footer();
2153     return $xml;
2154 }
2155
2156 =head2 _default_ind_to_space
2157
2158 Passed what should be an indicator returns a space
2159 if its undefined or zero length
2160
2161 =cut
2162
2163 sub _default_ind_to_space {
2164     my $s = shift;
2165     if ( !defined $s || $s eq q{} ) {
2166         return ' ';
2167     }
2168     return $s;
2169 }
2170
2171 =head2 TransformHtmlToMarc
2172
2173     L<$record> = TransformHtmlToMarc(L<$cgi>)
2174     L<$cgi> is the CGI object which contains the values for subfields
2175     {
2176         'tag_010_indicator1_531951' ,
2177         'tag_010_indicator2_531951' ,
2178         'tag_010_code_a_531951_145735' ,
2179         'tag_010_subfield_a_531951_145735' ,
2180         'tag_200_indicator1_873510' ,
2181         'tag_200_indicator2_873510' ,
2182         'tag_200_code_a_873510_673465' ,
2183         'tag_200_subfield_a_873510_673465' ,
2184         'tag_200_code_b_873510_704318' ,
2185         'tag_200_subfield_b_873510_704318' ,
2186         'tag_200_code_e_873510_280822' ,
2187         'tag_200_subfield_e_873510_280822' ,
2188         'tag_200_code_f_873510_110730' ,
2189         'tag_200_subfield_f_873510_110730' ,
2190     }
2191     L<$record> is the MARC::Record object.
2192
2193 =cut
2194
2195 sub TransformHtmlToMarc {
2196     my ($cgi, $isbiblio) = @_;
2197
2198     my @params = $cgi->multi_param();
2199
2200     # explicitly turn on the UTF-8 flag for all
2201     # 'tag_' parameters to avoid incorrect character
2202     # conversion later on
2203     my $cgi_params = $cgi->Vars;
2204     foreach my $param_name ( keys %$cgi_params ) {
2205         if ( $param_name =~ /^tag_/ ) {
2206             my $param_value = $cgi_params->{$param_name};
2207             unless ( Encode::is_utf8( $param_value ) ) {
2208                 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2209             }
2210         }
2211     }
2212
2213     # creating a new record
2214     my $record = MARC::Record->new();
2215     my @fields;
2216     my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2217     ($biblionumbertagfield, $biblionumbertagsubfield) =
2218         &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2219 #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!
2220     for (my $i = 0; $params[$i]; $i++ ) {    # browse all CGI params
2221         my $param    = $params[$i];
2222         my $newfield = 0;
2223
2224         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2225         if ( $param eq 'biblionumber' ) {
2226             if ( $biblionumbertagfield < 10 ) {
2227                 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2228             } else {
2229                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2230             }
2231             push @fields, $newfield if ($newfield);
2232         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2233             my $tag = $1;
2234
2235             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2236             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2237             $newfield = 0;
2238             my $j = $i + 2;
2239
2240             if ( $tag < 10 ) {                              # no code for theses fields
2241                                                             # in MARC editor, 000 contains the leader.
2242                 next if $tag == $biblionumbertagfield;
2243                 my $fval= $cgi->param($params[$j+1]);
2244                 if ( $tag eq '000' ) {
2245                     # Force a fake leader even if not provided to avoid crashing
2246                     # during decoding MARC record containing UTF-8 characters
2247                     $record->leader(
2248                         length( $fval ) == 24
2249                         ? $fval
2250                         : '     nam a22        4500'
2251                         )
2252                     ;
2253                     # between 001 and 009 (included)
2254                 } elsif ( $fval ne '' ) {
2255                     $newfield = MARC::Field->new( $tag, $fval, );
2256                 }
2257
2258                 # > 009, deal with subfields
2259             } else {
2260                 # browse subfields for this tag (reason for _code_ match)
2261                 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2262                     last unless defined $params[$j+1];
2263                     $j += 2 and next
2264                         if $tag == $biblionumbertagfield and
2265                            $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2266                     #if next param ne subfield, then it was probably empty
2267                     #try next param by incrementing j
2268                     if($params[$j+1]!~/_subfield_/) {$j++; next; }
2269                     my $fkey= $cgi->param($params[$j]);
2270                     my $fval= $cgi->param($params[$j+1]);
2271                     #check if subfield value not empty and field exists
2272                     if($fval ne '' && $newfield) {
2273                         $newfield->add_subfields( $fkey => $fval);
2274                     }
2275                     elsif($fval ne '') {
2276                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2277                     }
2278                     $j += 2;
2279                 } #end-of-while
2280                 $i= $j-1; #update i for outer loop accordingly
2281             }
2282             push @fields, $newfield if ($newfield);
2283         }
2284     }
2285
2286     @fields = sort { $a->tag() cmp $b->tag() } @fields;
2287     $record->append_fields(@fields);
2288     return $record;
2289 }
2290
2291 =head2 TransformMarcToKoha
2292
2293     $result = TransformMarcToKoha({ record => $record, limit_table => $limit })
2294
2295 Extract data from a MARC bib record into a hashref representing
2296 Koha biblio, biblioitems, and items fields.
2297
2298 If passed an undefined record will log the error and return an empty
2299 hash_ref.
2300
2301 =cut
2302
2303 sub TransformMarcToKoha {
2304     my ( $params ) = @_;
2305
2306     my $record = $params->{record};
2307     my $limit_table = $params->{limit_table} // q{};
2308     my $kohafields = $params->{kohafields};
2309
2310     my $result = {};
2311     if (!defined $record) {
2312         carp('TransformMarcToKoha called with undefined record');
2313         return $result;
2314     }
2315
2316     my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2317     if( $limit_table eq 'items' ) {
2318         %tables = ( items => 1 );
2319     } elsif ( $limit_table eq 'no_items' ){
2320         %tables = ( biblio => 1, biblioitems => 1 );
2321     }
2322
2323     # The next call acknowledges Default as the authoritative framework
2324     # for Koha to MARC mappings.
2325     my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2326     @{$kohafields} = keys %{ $mss } unless $kohafields;
2327     foreach my $kohafield ( @{$kohafields} ) {
2328         my ( $table, $column ) = split /[.]/, $kohafield, 2;
2329         next unless $tables{$table};
2330         my ( $value, @values );
2331         foreach my $fldhash ( @{$mss->{$kohafield}} ) {
2332             my $tag = $fldhash->{tagfield};
2333             my $sub = $fldhash->{tagsubfield};
2334             foreach my $fld ( $record->field($tag) ) {
2335                 if( $sub eq '@' || $fld->is_control_field ) {
2336                     push @values, $fld->data if $fld->data;
2337                 } else {
2338                     push @values, grep { $_ } $fld->subfield($sub);
2339                 }
2340             }
2341         }
2342         if ( @values ){
2343             $value = join ' | ', uniq(@values);
2344
2345             # Additional polishing for individual kohafields
2346             if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2347                 $value = _adjust_pubyear( $value );
2348             }
2349         }
2350
2351         next if !defined $value;
2352         my $key = _disambiguate( $table, $column );
2353         $result->{$key} = $value;
2354     }
2355     return $result;
2356 }
2357
2358 =head2 _disambiguate
2359
2360   $newkey = _disambiguate($table, $field);
2361
2362 This is a temporary hack to distinguish between the
2363 following sets of columns when using TransformMarcToKoha.
2364
2365   items.cn_source & biblioitems.cn_source
2366   items.cn_sort & biblioitems.cn_sort
2367
2368 Columns that are currently NOT distinguished (FIXME
2369 due to lack of time to fully test) are:
2370
2371   biblio.notes and biblioitems.notes
2372   biblionumber
2373   timestamp
2374   biblioitemnumber
2375
2376 FIXME - this is necessary because prefixing each column
2377 name with the table name would require changing lots
2378 of code and templates, and exposing more of the DB
2379 structure than is good to the UI templates, particularly
2380 since biblio and bibloitems may well merge in a future
2381 version.  In the future, it would also be good to
2382 separate DB access and UI presentation field names
2383 more.
2384
2385 =cut
2386
2387 sub _disambiguate {
2388     my ( $table, $column ) = @_;
2389     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2390         return $table . '.' . $column;
2391     } else {
2392         return $column;
2393     }
2394
2395 }
2396
2397 =head2 _adjust_pubyear
2398
2399     Helper routine for TransformMarcToKoha
2400
2401 =cut
2402
2403 sub _adjust_pubyear {
2404     my $retval = shift;
2405     # modify return value to keep only the 1st year found
2406     if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2407         $retval = $1;
2408     } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2409         $retval = $1;
2410     } elsif( $retval =~ m/(?<year>\d{1,3})[.Xx?-]/ ) {
2411         # See also bug 24674: enough to look at one unknown year char like .Xx-?
2412         # At this point in code 1234? or 1234- already passed the earlier regex
2413         # Things like 2-, 1xx, 1??? are now converted to a four positions-year.
2414         $retval = $+{year} * ( 10 ** (4-length($+{year})) );
2415     } else {
2416         $retval = undef;
2417     }
2418     return $retval;
2419 }
2420
2421 =head2 CountItemsIssued
2422
2423     my $count = CountItemsIssued( $biblionumber );
2424
2425 =cut
2426
2427 sub CountItemsIssued {
2428     my ($biblionumber) = @_;
2429     my $dbh            = C4::Context->dbh;
2430     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2431     $sth->execute($biblionumber);
2432     my $row = $sth->fetchrow_hashref();
2433     return $row->{'issuedCount'};
2434 }
2435
2436 =head2 ModZebra
2437
2438     ModZebra( $record_number, $op, $server );
2439
2440 $record_number is the authid or biblionumber we want to index
2441
2442 $op is the operation: specialUpdate or recordDelete
2443
2444 $server is authorityserver or biblioserver
2445
2446 =cut
2447
2448 sub ModZebra {
2449     my ( $record_number, $op, $server ) = @_;
2450     Koha::Logger->get->debug("ModZebra: updates requested for: $record_number $op $server");
2451     my $dbh = C4::Context->dbh;
2452
2453     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2454     # at the same time
2455     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2456     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2457     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2458     WHERE server = ?
2459         AND   biblio_auth_number = ?
2460         AND   operation = ?
2461         AND   done = 0";
2462     my $check_sth = $dbh->prepare_cached($check_sql);
2463     $check_sth->execute( $server, $record_number, $op );
2464     my ($count) = $check_sth->fetchrow_array;
2465     $check_sth->finish();
2466     if ( $count == 0 ) {
2467         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2468         $sth->execute( $record_number, $server, $op );
2469         $sth->finish;
2470     }
2471 }
2472
2473 =head2 EmbedItemsInMarcBiblio
2474
2475     EmbedItemsInMarcBiblio({
2476         marc_record  => $marc,
2477         biblionumber => $biblionumber,
2478         item_numbers => $itemnumbers,
2479         opac         => $opac });
2480
2481 Given a MARC::Record object containing a bib record,
2482 modify it to include the items attached to it as 9XX
2483 per the bib's MARC framework.
2484 if $itemnumbers is defined, only specified itemnumbers are embedded.
2485
2486 If $opac is true, then opac-relevant suppressions are included.
2487
2488 If opac filtering will be done, borcat should be passed to properly
2489 override if necessary.
2490
2491 =cut
2492
2493 sub EmbedItemsInMarcBiblio {
2494     my ($params) = @_;
2495     my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2496     $marc = $params->{marc_record};
2497     if ( !$marc ) {
2498         carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2499         return;
2500     }
2501     $biblionumber = $params->{biblionumber};
2502     $itemnumbers = $params->{item_numbers};
2503     $opac = $params->{opac};
2504     $borcat = $params->{borcat} // q{};
2505
2506     $itemnumbers = [] unless defined $itemnumbers;
2507
2508     my $frameworkcode = GetFrameworkCode($biblionumber);
2509     _strip_item_fields($marc, $frameworkcode);
2510
2511     # ... and embed the current items
2512     my $dbh = C4::Context->dbh;
2513     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2514     $sth->execute($biblionumber);
2515     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
2516
2517     my @item_fields; # Array holding the actual MARC data for items to be included.
2518     my @items;       # Array holding items which are both in the list (sitenumbers)
2519                      # and on this biblionumber
2520
2521     # Flag indicating if there is potential hiding.
2522     my $opachiddenitems = $opac
2523       && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2524
2525     while ( my ($itemnumber) = $sth->fetchrow_array ) {
2526         next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2527         my $item;
2528         if ( $opachiddenitems ) {
2529             $item = Koha::Items->find($itemnumber);
2530             $item = $item ? $item->unblessed : undef;
2531         }
2532         push @items, { itemnumber => $itemnumber, item => $item };
2533     }
2534     my @items2pass = map { $_->{item} } @items;
2535     my @hiddenitems =
2536       $opachiddenitems
2537       ? C4::Items::GetHiddenItemnumbers({
2538             items  => \@items2pass,
2539             borcat => $borcat })
2540       : ();
2541     # Convert to a hash for quick searching
2542     my %hiddenitems = map { $_ => 1 } @hiddenitems;
2543     foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2544         next if $hiddenitems{$itemnumber};
2545         my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2546         push @item_fields, $item_marc->field($itemtag);
2547     }
2548     $marc->append_fields(@item_fields);
2549 }
2550
2551 =head1 INTERNAL FUNCTIONS
2552
2553 =head2 _koha_marc_update_bib_ids
2554
2555
2556   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2557
2558 Internal function to add or update biblionumber and biblioitemnumber to
2559 the MARC XML.
2560
2561 =cut
2562
2563 sub _koha_marc_update_bib_ids {
2564     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2565
2566     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber" );
2567     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2568     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber" );
2569     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2570
2571     if ( $biblio_tag < 10 ) {
2572         C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2573     } else {
2574         C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2575     }
2576     if ( $biblioitem_tag < 10 ) {
2577         C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2578     } else {
2579         C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2580     }
2581 }
2582
2583 =head2 _koha_marc_update_biblioitem_cn_sort
2584
2585   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2586
2587 Given a MARC bib record and the biblioitem hash, update the
2588 subfield that contains a copy of the value of biblioitems.cn_sort.
2589
2590 =cut
2591
2592 sub _koha_marc_update_biblioitem_cn_sort {
2593     my $marc          = shift;
2594     my $biblioitem    = shift;
2595     my $frameworkcode = shift;
2596
2597     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort" );
2598     return unless $biblioitem_tag;
2599
2600     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2601
2602     if ( my $field = $marc->field($biblioitem_tag) ) {
2603         $field->delete_subfield( code => $biblioitem_subfield );
2604         if ( $cn_sort ne '' ) {
2605             $field->add_subfields( $biblioitem_subfield => $cn_sort );
2606         }
2607     } else {
2608
2609         # if we get here, no biblioitem tag is present in the MARC record, so
2610         # we'll create it if $cn_sort is not empty -- this would be
2611         # an odd combination of events, however
2612         if ($cn_sort) {
2613             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2614         }
2615     }
2616 }
2617
2618 =head2 _koha_modify_biblio
2619
2620   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2621
2622 Internal function for updating the biblio table
2623
2624 =cut
2625
2626 sub _koha_modify_biblio {
2627     my ( $dbh, $biblio, $frameworkcode ) = @_;
2628     my $error;
2629
2630     my $query = "
2631         UPDATE biblio
2632         SET    frameworkcode = ?,
2633                author = ?,
2634                title = ?,
2635                subtitle = ?,
2636                medium = ?,
2637                part_number = ?,
2638                part_name = ?,
2639                unititle = ?,
2640                notes = ?,
2641                serial = ?,
2642                seriestitle = ?,
2643                copyrightdate = ?,
2644                abstract = ?
2645         WHERE  biblionumber = ?
2646         "
2647       ;
2648     my $sth = $dbh->prepare($query);
2649
2650     $sth->execute(
2651         $frameworkcode,        $biblio->{'author'},      $biblio->{'title'},       $biblio->{'subtitle'},
2652         $biblio->{'medium'},   $biblio->{'part_number'}, $biblio->{'part_name'},   $biblio->{'unititle'},
2653         $biblio->{'notes'},    $biblio->{'serial'},      $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef,
2654         $biblio->{'abstract'}, $biblio->{'biblionumber'}
2655     ) if $biblio->{'biblionumber'};
2656
2657     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2658         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2659         warn $error;
2660     }
2661     return ( $biblio->{'biblionumber'}, $error );
2662 }
2663
2664 =head2 _koha_modify_biblioitem_nonmarc
2665
2666   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2667
2668 =cut
2669
2670 sub _koha_modify_biblioitem_nonmarc {
2671     my ( $dbh, $biblioitem ) = @_;
2672     my $error;
2673
2674     # re-calculate the cn_sort, it may have changed
2675     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2676
2677     my $query = "UPDATE biblioitems
2678     SET biblionumber    = ?,
2679         volume          = ?,
2680         number          = ?,
2681         itemtype        = ?,
2682         isbn            = ?,
2683         issn            = ?,
2684         publicationyear = ?,
2685         publishercode   = ?,
2686         volumedate      = ?,
2687         volumedesc      = ?,
2688         collectiontitle = ?,
2689         collectionissn  = ?,
2690         collectionvolume= ?,
2691         editionstatement= ?,
2692         editionresponsibility = ?,
2693         illus           = ?,
2694         pages           = ?,
2695         notes           = ?,
2696         size            = ?,
2697         place           = ?,
2698         lccn            = ?,
2699         url             = ?,
2700         cn_source       = ?,
2701         cn_class        = ?,
2702         cn_item         = ?,
2703         cn_suffix       = ?,
2704         cn_sort         = ?,
2705         totalissues     = ?,
2706         ean             = ?,
2707         agerestriction  = ?
2708         where biblioitemnumber = ?
2709         ";
2710     my $sth = $dbh->prepare($query);
2711     $sth->execute(
2712         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
2713         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
2714         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
2715         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2716         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
2717         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2718         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
2719         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
2720     );
2721     if ( $dbh->errstr ) {
2722         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2723         warn $error;
2724     }
2725     return ( $biblioitem->{'biblioitemnumber'}, $error );
2726 }
2727
2728 =head2 _koha_delete_biblio
2729
2730   $error = _koha_delete_biblio($dbh,$biblionumber);
2731
2732 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2733
2734 C<$dbh> - the database handle
2735
2736 C<$biblionumber> - the biblionumber of the biblio to be deleted
2737
2738 =cut
2739
2740 # FIXME: add error handling
2741
2742 sub _koha_delete_biblio {
2743     my ( $dbh, $biblionumber ) = @_;
2744
2745     # get all the data for this biblio
2746     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2747     $sth->execute($biblionumber);
2748
2749     # FIXME There is a transaction in _koha_delete_biblio_metadata
2750     # But actually all the following should be done inside a single transaction
2751     if ( my $data = $sth->fetchrow_hashref ) {
2752
2753         # save the record in deletedbiblio
2754         # find the fields to save
2755         my $query = "INSERT INTO deletedbiblio SET ";
2756         my @bind  = ();
2757         foreach my $temp ( keys %$data ) {
2758             $query .= "$temp = ?,";
2759             push( @bind, $data->{$temp} );
2760         }
2761
2762         # replace the last , by ",?)"
2763         $query =~ s/\,$//;
2764         my $bkup_sth = $dbh->prepare($query);
2765         $bkup_sth->execute(@bind);
2766         $bkup_sth->finish;
2767
2768         _koha_delete_biblio_metadata( $biblionumber );
2769
2770         # delete the biblio
2771         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2772         $sth2->execute($biblionumber);
2773         # update the timestamp (Bugzilla 7146)
2774         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
2775         $sth2->execute($biblionumber);
2776         $sth2->finish;
2777     }
2778     $sth->finish;
2779     return;
2780 }
2781
2782 =head2 _koha_delete_biblioitems
2783
2784   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2785
2786 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2787
2788 C<$dbh> - the database handle
2789 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2790
2791 =cut
2792
2793 # FIXME: add error handling
2794
2795 sub _koha_delete_biblioitems {
2796     my ( $dbh, $biblioitemnumber ) = @_;
2797
2798     # get all the data for this biblioitem
2799     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2800     $sth->execute($biblioitemnumber);
2801
2802     if ( my $data = $sth->fetchrow_hashref ) {
2803
2804         # save the record in deletedbiblioitems
2805         # find the fields to save
2806         my $query = "INSERT INTO deletedbiblioitems SET ";
2807         my @bind  = ();
2808         foreach my $temp ( keys %$data ) {
2809             $query .= "$temp = ?,";
2810             push( @bind, $data->{$temp} );
2811         }
2812
2813         # replace the last , by ",?)"
2814         $query =~ s/\,$//;
2815         my $bkup_sth = $dbh->prepare($query);
2816         $bkup_sth->execute(@bind);
2817         $bkup_sth->finish;
2818
2819         # delete the biblioitem
2820         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2821         $sth2->execute($biblioitemnumber);
2822         # update the timestamp (Bugzilla 7146)
2823         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
2824         $sth2->execute($biblioitemnumber);
2825         $sth2->finish;
2826     }
2827     $sth->finish;
2828     return;
2829 }
2830
2831 =head2 _koha_delete_biblio_metadata
2832
2833   $error = _koha_delete_biblio_metadata($biblionumber);
2834
2835 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
2836
2837 =cut
2838
2839 sub _koha_delete_biblio_metadata {
2840     my ($biblionumber) = @_;
2841
2842     my $dbh    = C4::Context->dbh;
2843     my $schema = Koha::Database->new->schema;
2844     $schema->txn_do(
2845         sub {
2846             $dbh->do( q|
2847                 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
2848                 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
2849             |,  undef, $biblionumber );
2850             $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
2851                 undef, $biblionumber );
2852         }
2853     );
2854 }
2855
2856 =head1 UNEXPORTED FUNCTIONS
2857
2858 =head2 ModBiblioMarc
2859
2860   ModBiblioMarc($newrec,$biblionumber);
2861
2862 Add MARC XML data for a biblio to koha
2863
2864 Function exported, but should NOT be used, unless you really know what you're doing
2865
2866 =cut
2867
2868 sub ModBiblioMarc {
2869     # pass the MARC::Record to this function, and it will create the records in
2870     # the marcxml field
2871     my ( $record, $biblionumber, $params ) = @_;
2872     if ( !$record ) {
2873         carp 'ModBiblioMarc passed an undefined record';
2874         return;
2875     }
2876
2877     my $skip_record_index = $params->{skip_record_index} || 0;
2878
2879     # Clone record as it gets modified
2880     $record = $record->clone();
2881     my $dbh    = C4::Context->dbh;
2882     my @fields = $record->fields();
2883     my $encoding = C4::Context->preference("marcflavour");
2884
2885     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
2886     if ( $encoding eq "UNIMARC" ) {
2887         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
2888         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
2889         my $string = $record->subfield( 100, "a" );
2890         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
2891             my $f100 = $record->field(100);
2892             $record->delete_field($f100);
2893         } else {
2894             $string = POSIX::strftime( "%Y%m%d", localtime );
2895             $string =~ s/\-//g;
2896             $string = sprintf( "%-*s", 35, $string );
2897             substr ( $string, 22, 3, $defaultlanguage);
2898         }
2899         substr( $string, 25, 3, "y50" );
2900         unless ( $record->subfield( 100, "a" ) ) {
2901             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
2902         }
2903     }
2904
2905     #enhancement 5374: update transaction date (005) for marc21/unimarc
2906     if($encoding =~ /MARC21|UNIMARC/) {
2907       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
2908         # YY MM DD HH MM SS (update year and month)
2909       my $f005= $record->field('005');
2910       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
2911     }
2912
2913     my $metadata = {
2914         biblionumber => $biblionumber,
2915         format       => 'marcxml',
2916         schema       => C4::Context->preference('marcflavour'),
2917     };
2918     $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
2919
2920     my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
2921         Koha::Biblio::Metadata->new($metadata);
2922
2923     my $userenv = C4::Context->userenv;
2924     if ($userenv) {
2925         my $borrowernumber = $userenv->{number};
2926         my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
2927         unless ($m_rs->in_storage) {
2928             Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
2929             Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
2930         }
2931         Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
2932         Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
2933     }
2934
2935     $m_rs->metadata( $record->as_xml_record($encoding) );
2936     $m_rs->store;
2937
2938     unless ( $skip_record_index ) {
2939         my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
2940         $indexer->index_records( $biblionumber, "specialUpdate", "biblioserver" );
2941     }
2942
2943     return $biblionumber;
2944 }
2945
2946 =head2 prepare_host_field
2947
2948 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
2949 Generate the host item entry for an analytic child entry
2950
2951 =cut
2952
2953 sub prepare_host_field {
2954     my ( $hostbiblio, $marcflavour ) = @_;
2955     $marcflavour ||= C4::Context->preference('marcflavour');
2956
2957     my $biblio = Koha::Biblios->find($hostbiblio);
2958     my $host = $biblio->metadata->record;
2959     # unfortunately as_string does not 'do the right thing'
2960     # if field returns undef
2961     my %sfd;
2962     my $field;
2963     my $host_field;
2964     if ( $marcflavour eq 'MARC21' ) {
2965         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
2966             my $s = $field->as_string('ab');
2967             if ($s) {
2968                 $sfd{a} = $s;
2969             }
2970         }
2971         if ( $field = $host->field('245') ) {
2972             my $s = $field->as_string('a');
2973             if ($s) {
2974                 $sfd{t} = $s;
2975             }
2976         }
2977         if ( $field = $host->field('260') ) {
2978             my $s = $field->as_string('abc');
2979             if ($s) {
2980                 $sfd{d} = $s;
2981             }
2982         }
2983         if ( $field = $host->field('240') ) {
2984             my $s = $field->as_string();
2985             if ($s) {
2986                 $sfd{b} = $s;
2987             }
2988         }
2989         if ( $field = $host->field('022') ) {
2990             my $s = $field->as_string('a');
2991             if ($s) {
2992                 $sfd{x} = $s;
2993             }
2994         }
2995         if ( $field = $host->field('020') ) {
2996             my $s = $field->as_string('a');
2997             if ($s) {
2998                 $sfd{z} = $s;
2999             }
3000         }
3001         if ( $field = $host->field('001') ) {
3002             $sfd{w} = $field->data(),;
3003         }
3004         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3005         return $host_field;
3006     }
3007     elsif ( $marcflavour eq 'UNIMARC' ) {
3008         #author
3009         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3010             my $s = $field->as_string('ab');
3011             if ($s) {
3012                 $sfd{a} = $s;
3013             }
3014         }
3015         #title
3016         if ( $field = $host->field('200') ) {
3017             my $s = $field->as_string('a');
3018             if ($s) {
3019                 $sfd{t} = $s;
3020             }
3021         }
3022         #place of publicaton
3023         if ( $field = $host->field('210') ) {
3024             my $s = $field->as_string('a');
3025             if ($s) {
3026                 $sfd{c} = $s;
3027             }
3028         }
3029         #date of publication
3030         if ( $field = $host->field('210') ) {
3031             my $s = $field->as_string('d');
3032             if ($s) {
3033                 $sfd{d} = $s;
3034             }
3035         }
3036         #edition statement
3037         if ( $field = $host->field('205') ) {
3038             my $s = $field->as_string();
3039             if ($s) {
3040                 $sfd{e} = $s;
3041             }
3042         }
3043         #URL
3044         if ( $field = $host->field('856') ) {
3045             my $s = $field->as_string('u');
3046             if ($s) {
3047                 $sfd{u} = $s;
3048             }
3049         }
3050         #ISSN
3051         if ( $field = $host->field('011') ) {
3052             my $s = $field->as_string('a');
3053             if ($s) {
3054                 $sfd{x} = $s;
3055             }
3056         }
3057         #ISBN
3058         if ( $field = $host->field('010') ) {
3059             my $s = $field->as_string('a');
3060             if ($s) {
3061                 $sfd{y} = $s;
3062             }
3063         }
3064         if ( $field = $host->field('001') ) {
3065             $sfd{0} = $field->data(),;
3066         }
3067         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3068         return $host_field;
3069     }
3070     return;
3071 }
3072
3073
3074 =head2 UpdateTotalIssues
3075
3076   UpdateTotalIssues($biblionumber, $increase, [$value])
3077
3078 Update the total issue count for a particular bib record.
3079
3080 =over 4
3081
3082 =item C<$biblionumber> is the biblionumber of the bib to update
3083
3084 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3085
3086 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3087
3088 =back
3089
3090 =cut
3091
3092 sub UpdateTotalIssues {
3093     my ($biblionumber, $increase, $value, $skip_holds_queue) = @_;
3094     my $totalissues;
3095
3096     my $biblio = Koha::Biblios->find($biblionumber);
3097     unless ($biblio) {
3098         carp "UpdateTotalIssues could not get datas of biblio";
3099         return;
3100     }
3101
3102     my $record = $biblio->metadata->record;
3103     unless ($record) {
3104         carp "UpdateTotalIssues could not get biblio record";
3105         return;
3106     }
3107     my $biblioitem = $biblio->biblioitem;
3108     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField( 'biblioitems.totalissues' );
3109     unless ($totalissuestag) {
3110         return 1; # There is nothing to do
3111     }
3112
3113     if (defined $value) {
3114         $totalissues = $value;
3115     } else {
3116         $totalissues = $biblioitem->totalissues + $increase;
3117     }
3118
3119      my $field = $record->field($totalissuestag);
3120      if (defined $field) {
3121          $field->update( $totalissuessubfield => $totalissues );
3122      } else {
3123          $field = MARC::Field->new($totalissuestag, '0', '0',
3124                  $totalissuessubfield => $totalissues);
3125          $record->insert_grouped_field($field);
3126      }
3127
3128      return ModBiblio($record, $biblionumber, $biblio->frameworkcode, { skip_holds_queue => $skip_holds_queue });
3129 }
3130
3131 =head2 RemoveAllNsb
3132
3133     &RemoveAllNsb($record);
3134
3135 Removes all nsb/nse chars from a record
3136
3137 =cut
3138
3139 sub RemoveAllNsb {
3140     my $record = shift;
3141     if (!$record) {
3142         carp 'RemoveAllNsb called with undefined record';
3143         return;
3144     }
3145
3146     SetUTF8Flag($record);
3147
3148     foreach my $field ($record->fields()) {
3149         if ($field->is_control_field()) {
3150             $field->update(nsb_clean($field->data()));
3151         } else {
3152             my @subfields = $field->subfields();
3153             my @new_subfields;
3154             foreach my $subfield (@subfields) {
3155                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3156             }
3157             if (scalar(@new_subfields) > 0) {
3158                 my $new_field;
3159                 eval {
3160                     $new_field = MARC::Field->new(
3161                         $field->tag(),
3162                         $field->indicator(1),
3163                         $field->indicator(2),
3164                         @new_subfields
3165                     );
3166                 };
3167                 if ($@) {
3168                     warn "error in RemoveAllNsb : $@";
3169                 } else {
3170                     $field->replace_with($new_field);
3171                 }
3172             }
3173         }
3174     }
3175
3176     return $record;
3177 }
3178
3179 =head2 ApplyMarcOverlayRules
3180
3181     my $record = ApplyMarcOverlayRules($params)
3182
3183 Applies marc merge rules to a record.
3184
3185 C<$params> is expected to be a hashref with below keys defined.
3186
3187 =over 4
3188
3189 =item C<biblionumber>
3190 biblionumber of old record
3191
3192 =item C<record>
3193 Incoming record that will be merged with old record
3194
3195 =item C<overlay_context>
3196 hashref containing at least one context module and filter value on
3197 the form {module => filter, ...}.
3198
3199 =back
3200
3201 Returns:
3202
3203 =over 4
3204
3205 =item C<$record>
3206
3207 Merged MARC record based with merge rules for C<context> applied. If no old
3208 record for C<biblionumber> can be found, C<record> is returned unchanged.
3209 Default action when no matching context is found to return C<record> unchanged.
3210 If no rules are found for a certain field tag the default is to overwrite with
3211 fields with this field tag from C<record>.
3212
3213 =back
3214
3215 =cut
3216
3217 sub ApplyMarcOverlayRules {
3218     my ($params) = @_;
3219     my $biblionumber = $params->{biblionumber};
3220     my $incoming_record = $params->{record};
3221
3222     if (!$biblionumber) {
3223         carp 'ApplyMarcOverlayRules called on undefined biblionumber';
3224         return;
3225     }
3226     if (!$incoming_record) {
3227         carp 'ApplyMarcOverlayRules called on undefined record';
3228         return;
3229     }
3230     my $biblio = Koha::Biblios->find($biblionumber);
3231     my $old_record = $biblio->metadata->record;
3232
3233     # Skip overlay rules if called with no context
3234     if ($old_record && defined $params->{overlay_context}) {
3235         return Koha::MarcOverlayRules->merge_records($old_record, $incoming_record, $params->{overlay_context});
3236     }
3237     return $incoming_record;
3238 }
3239
3240 =head2 _after_biblio_action_hooks
3241
3242 Helper method that takes care of calling all plugin hooks
3243
3244 =cut
3245
3246 sub _after_biblio_action_hooks {
3247     my ( $args ) = @_;
3248
3249     my $biblio_id = $args->{biblio_id};
3250     my $action    = $args->{action};
3251
3252     my $biblio = Koha::Biblios->find( $biblio_id );
3253     Koha::Plugins->call(
3254         'after_biblio_action',
3255         {
3256             action    => $action,
3257             biblio    => $biblio,
3258             biblio_id => $biblio_id,
3259         }
3260     );
3261 }
3262
3263 1;
3264
3265 __END__
3266
3267 =head1 AUTHOR
3268
3269 Koha Development Team <http://koha-community.org/>
3270
3271 Paul POULAIN paul.poulain@free.fr
3272
3273 Joshua Ferraro jmf@liblime.com
3274
3275 =cut