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