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