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