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