C4/Biblio.pm

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