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