C4/Biblio.pm

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