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