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 && $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 $str = ( $indicator->[$j] // q{} ) . '  '; # extra space prevents substr outside of string warn
2176             my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2177             my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2178             if ( !$first ) {
2179                 $xml .= "</datafield>\n";
2180                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2181                     && ( @$values[$i] ne "" ) ) {
2182                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2183                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2184                     $first = 0;
2185                     $close_last_tag = 1;
2186                 } else {
2187                     $first = 1;
2188                 }
2189             } else {
2190                 if ( @$values[$i] ne "" ) {
2191
2192                     # leader
2193                     if ( @$tags[$i] eq "000" ) {
2194                         $xml .= "<leader>@$values[$i]</leader>\n";
2195                         $first = 1;
2196
2197                         # rest of the fixed fields
2198                     } elsif ( @$tags[$i] < 10 ) {
2199                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2200                         $first = 1;
2201                     } else {
2202                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2203                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2204                         $first = 0;
2205                         $close_last_tag = 1;
2206                     }
2207                 }
2208             }
2209         } else {    # @$tags[$i] eq $prevtag
2210             if ( @$values[$i] eq "" ) {
2211             } else {
2212                 if ($first) {
2213                     my $str = ( $indicator->[$j] // q{} ) . '  '; # extra space prevents substr outside of string warn
2214                     my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2215                     my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2216                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2217                     $first = 0;
2218                     $close_last_tag = 1;
2219                 }
2220                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2221             }
2222         }
2223         $prevtag = @$tags[$i];
2224     }
2225     $xml .= "</datafield>\n" if $close_last_tag;
2226     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2227
2228         #     warn "SETTING 100 for $auth_type";
2229         my $string = strftime( "%Y%m%d", localtime(time) );
2230
2231         # set 50 to position 26 is biblios, 13 if authorities
2232         my $pos = 26;
2233         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2234         $string = sprintf( "%-*s", 35, $string );
2235         substr( $string, $pos, 6, "50" );
2236         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2237         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2238         $xml .= "</datafield>\n";
2239     }
2240     $xml .= "</record>\n";
2241     $xml .= MARC::File::XML::footer();
2242     return $xml;
2243 }
2244
2245 =head2 _default_ind_to_space
2246
2247 Passed what should be an indicator returns a space
2248 if its undefined or zero length
2249
2250 =cut
2251
2252 sub _default_ind_to_space {
2253     my $s = shift;
2254     if ( !defined $s || $s eq q{} ) {
2255         return ' ';
2256     }
2257     return $s;
2258 }
2259
2260 =head2 TransformHtmlToMarc
2261
2262     L<$record> = TransformHtmlToMarc(L<$cgi>)
2263     L<$cgi> is the CGI object which contains the values for subfields
2264     {
2265         'tag_010_indicator1_531951' ,
2266         'tag_010_indicator2_531951' ,
2267         'tag_010_code_a_531951_145735' ,
2268         'tag_010_subfield_a_531951_145735' ,
2269         'tag_200_indicator1_873510' ,
2270         'tag_200_indicator2_873510' ,
2271         'tag_200_code_a_873510_673465' ,
2272         'tag_200_subfield_a_873510_673465' ,
2273         'tag_200_code_b_873510_704318' ,
2274         'tag_200_subfield_b_873510_704318' ,
2275         'tag_200_code_e_873510_280822' ,
2276         'tag_200_subfield_e_873510_280822' ,
2277         'tag_200_code_f_873510_110730' ,
2278         'tag_200_subfield_f_873510_110730' ,
2279     }
2280     L<$record> is the MARC::Record object.
2281
2282 =cut
2283
2284 sub TransformHtmlToMarc {
2285     my ($cgi, $isbiblio) = @_;
2286
2287     my @params = $cgi->multi_param();
2288
2289     # explicitly turn on the UTF-8 flag for all
2290     # 'tag_' parameters to avoid incorrect character
2291     # conversion later on
2292     my $cgi_params = $cgi->Vars;
2293     foreach my $param_name ( keys %$cgi_params ) {
2294         if ( $param_name =~ /^tag_/ ) {
2295             my $param_value = $cgi_params->{$param_name};
2296             unless ( Encode::is_utf8( $param_value ) ) {
2297                 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2298             }
2299         }
2300     }
2301
2302     # creating a new record
2303     my $record = MARC::Record->new();
2304     my @fields;
2305     my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2306     ($biblionumbertagfield, $biblionumbertagsubfield) =
2307         &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2308 #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!
2309     for (my $i = 0; $params[$i]; $i++ ) {    # browse all CGI params
2310         my $param    = $params[$i];
2311         my $newfield = 0;
2312
2313         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2314         if ( $param eq 'biblionumber' ) {
2315             if ( $biblionumbertagfield < 10 ) {
2316                 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2317             } else {
2318                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2319             }
2320             push @fields, $newfield if ($newfield);
2321         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2322             my $tag = $1;
2323
2324             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2325             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2326             $newfield = 0;
2327             my $j = $i + 2;
2328
2329             if ( $tag < 10 ) {                              # no code for theses fields
2330                                                             # in MARC editor, 000 contains the leader.
2331                 next if $tag == $biblionumbertagfield;
2332                 my $fval= $cgi->param($params[$j+1]);
2333                 if ( $tag eq '000' ) {
2334                     # Force a fake leader even if not provided to avoid crashing
2335                     # during decoding MARC record containing UTF-8 characters
2336                     $record->leader(
2337                         length( $fval ) == 24
2338                         ? $fval
2339                         : '     nam a22        4500'
2340                         )
2341                     ;
2342                     # between 001 and 009 (included)
2343                 } elsif ( $fval ne '' ) {
2344                     $newfield = MARC::Field->new( $tag, $fval, );
2345                 }
2346
2347                 # > 009, deal with subfields
2348             } else {
2349                 # browse subfields for this tag (reason for _code_ match)
2350                 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2351                     last unless defined $params[$j+1];
2352                     $j += 2 and next
2353                         if $tag == $biblionumbertagfield and
2354                            $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2355                     #if next param ne subfield, then it was probably empty
2356                     #try next param by incrementing j
2357                     if($params[$j+1]!~/_subfield_/) {$j++; next; }
2358                     my $fkey= $cgi->param($params[$j]);
2359                     my $fval= $cgi->param($params[$j+1]);
2360                     #check if subfield value not empty and field exists
2361                     if($fval ne '' && $newfield) {
2362                         $newfield->add_subfields( $fkey => $fval);
2363                     }
2364                     elsif($fval ne '') {
2365                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2366                     }
2367                     $j += 2;
2368                 } #end-of-while
2369                 $i= $j-1; #update i for outer loop accordingly
2370             }
2371             push @fields, $newfield if ($newfield);
2372         }
2373     }
2374
2375     $record->append_fields(@fields);
2376     return $record;
2377 }
2378
2379 =head2 TransformMarcToKoha
2380
2381     $result = TransformMarcToKoha( $record, undef, $limit )
2382
2383 Extract data from a MARC bib record into a hashref representing
2384 Koha biblio, biblioitems, and items fields.
2385
2386 If passed an undefined record will log the error and return an empty
2387 hash_ref.
2388
2389 =cut
2390
2391 sub TransformMarcToKoha {
2392     my ( $record, $frameworkcode, $limit_table ) = @_;
2393     # FIXME  Parameter $frameworkcode is obsolete and will be removed
2394     $limit_table //= q{};
2395
2396     my $result = {};
2397     if (!defined $record) {
2398         carp('TransformMarcToKoha called with undefined record');
2399         return $result;
2400     }
2401
2402     my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2403     if( $limit_table eq 'items' ) {
2404         %tables = ( items => 1 );
2405     }
2406
2407     # The next call acknowledges Default as the authoritative framework
2408     # for Koha to MARC mappings.
2409     my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2410     foreach my $kohafield ( keys %{ $mss } ) {
2411         my ( $table, $column ) = split /[.]/, $kohafield, 2;
2412         next unless $tables{$table};
2413         my $val = TransformMarcToKohaOneField( $kohafield, $record );
2414         next if !defined $val;
2415         my $key = _disambiguate( $table, $column );
2416         $result->{$key} = $val;
2417     }
2418     return $result;
2419 }
2420
2421 =head2 _disambiguate
2422
2423   $newkey = _disambiguate($table, $field);
2424
2425 This is a temporary hack to distinguish between the
2426 following sets of columns when using TransformMarcToKoha.
2427
2428   items.cn_source & biblioitems.cn_source
2429   items.cn_sort & biblioitems.cn_sort
2430
2431 Columns that are currently NOT distinguished (FIXME
2432 due to lack of time to fully test) are:
2433
2434   biblio.notes and biblioitems.notes
2435   biblionumber
2436   timestamp
2437   biblioitemnumber
2438
2439 FIXME - this is necessary because prefixing each column
2440 name with the table name would require changing lots
2441 of code and templates, and exposing more of the DB
2442 structure than is good to the UI templates, particularly
2443 since biblio and bibloitems may well merge in a future
2444 version.  In the future, it would also be good to
2445 separate DB access and UI presentation field names
2446 more.
2447
2448 =cut
2449
2450 sub _disambiguate {
2451     my ( $table, $column ) = @_;
2452     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2453         return $table . '.' . $column;
2454     } else {
2455         return $column;
2456     }
2457
2458 }
2459
2460 =head2 TransformMarcToKohaOneField
2461
2462     $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2463
2464     Note: The authoritative Default framework is used implicitly.
2465
2466 =cut
2467
2468 sub TransformMarcToKohaOneField {
2469     my ( $kohafield, $marc ) = @_;
2470
2471     my ( @rv, $retval );
2472     my @mss = GetMarcSubfieldStructureFromKohaField($kohafield);
2473     foreach my $fldhash ( @mss ) {
2474         my $tag = $fldhash->{tagfield};
2475         my $sub = $fldhash->{tagsubfield};
2476         foreach my $fld ( $marc->field($tag) ) {
2477             if( $sub eq '@' || $fld->is_control_field ) {
2478                 push @rv, $fld->data if $fld->data;
2479             } else {
2480                 push @rv, grep { $_ } $fld->subfield($sub);
2481             }
2482         }
2483     }
2484     return unless @rv;
2485     $retval = join ' | ', uniq(@rv);
2486
2487     # Additional polishing for individual kohafields
2488     if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2489         $retval = _adjust_pubyear( $retval );
2490     }
2491
2492     return $retval;
2493 }
2494
2495 =head2 _adjust_pubyear
2496
2497     Helper routine for TransformMarcToKohaOneField
2498
2499 =cut
2500
2501 sub _adjust_pubyear {
2502     my $retval = shift;
2503     # modify return value to keep only the 1st year found
2504     if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2505         $retval = $1;
2506     } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2507         $retval = $1;
2508     } elsif( $retval =~ m/
2509              (?<year>\d)[-]?[.Xx?]{3}
2510             |(?<year>\d{2})[.Xx?]{2}
2511             |(?<year>\d{3})[.Xx?]
2512             |(?<year>\d)[-]{3}\?
2513             |(?<year>\d\d)[-]{2}\?
2514             |(?<year>\d{3})[-]\?
2515     /xms ) { # the form 198-? occurred in Dutch ISBD rules
2516         my $digits = $+{year};
2517         $retval = $digits * ( 10 ** ( 4 - length($digits) ));
2518     }
2519     return $retval;
2520 }
2521
2522 =head2 CountItemsIssued
2523
2524     my $count = CountItemsIssued( $biblionumber );
2525
2526 =cut
2527
2528 sub CountItemsIssued {
2529     my ($biblionumber) = @_;
2530     my $dbh            = C4::Context->dbh;
2531     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2532     $sth->execute($biblionumber);
2533     my $row = $sth->fetchrow_hashref();
2534     return $row->{'issuedCount'};
2535 }
2536
2537 =head2 ModZebra
2538
2539   ModZebra( $biblionumber, $op, $server, $record );
2540
2541 $biblionumber is the biblionumber we want to index
2542
2543 $op is specialUpdate or recordDelete, and is used to know what we want to do
2544
2545 $server is the server that we want to update
2546
2547 $record is the update MARC record if it's available. If it's not supplied
2548 and is needed, it'll be loaded from the database.
2549
2550 =cut
2551
2552 sub ModZebra {
2553 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2554     my ( $biblionumber, $op, $server, $record ) = @_;
2555     $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2556     if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
2557
2558         # TODO abstract to a standard API that'll work for whatever
2559         require Koha::SearchEngine::Elasticsearch::Indexer;
2560         my $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
2561             {
2562                 index => $server eq 'biblioserver'
2563                 ? $Koha::SearchEngine::BIBLIOS_INDEX
2564                 : $Koha::SearchEngine::AUTHORITIES_INDEX
2565             }
2566         );
2567         if ( $op eq 'specialUpdate' ) {
2568             unless ($record) {
2569                 $record = GetMarcBiblio({
2570                     biblionumber => $biblionumber,
2571                     embed_items  => 1 });
2572             }
2573             my $records = [$record];
2574             $indexer->update_index_background( [$biblionumber], [$record] );
2575         }
2576         elsif ( $op eq 'recordDelete' ) {
2577             $indexer->delete_index_background( [$biblionumber] );
2578         }
2579         else {
2580             croak "ModZebra called with unknown operation: $op";
2581         }
2582     }
2583
2584     my $dbh = C4::Context->dbh;
2585
2586     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2587     # at the same time
2588     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2589     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2590     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2591     WHERE server = ?
2592         AND   biblio_auth_number = ?
2593         AND   operation = ?
2594         AND   done = 0";
2595     my $check_sth = $dbh->prepare_cached($check_sql);
2596     $check_sth->execute( $server, $biblionumber, $op );
2597     my ($count) = $check_sth->fetchrow_array;
2598     $check_sth->finish();
2599     if ( $count == 0 ) {
2600         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2601         $sth->execute( $biblionumber, $server, $op );
2602         $sth->finish;
2603     }
2604 }
2605
2606
2607 =head2 EmbedItemsInMarcBiblio
2608
2609     EmbedItemsInMarcBiblio({
2610         marc_record  => $marc,
2611         biblionumber => $biblionumber,
2612         item_numbers => $itemnumbers,
2613         opac         => $opac });
2614
2615 Given a MARC::Record object containing a bib record,
2616 modify it to include the items attached to it as 9XX
2617 per the bib's MARC framework.
2618 if $itemnumbers is defined, only specified itemnumbers are embedded.
2619
2620 If $opac is true, then opac-relevant suppressions are included.
2621
2622 If opac filtering will be done, borcat should be passed to properly
2623 override if necessary.
2624
2625 =cut
2626
2627 sub EmbedItemsInMarcBiblio {
2628     my ($params) = @_;
2629     my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2630     $marc = $params->{marc_record};
2631     if ( !$marc ) {
2632         carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2633         return;
2634     }
2635     $biblionumber = $params->{biblionumber};
2636     $itemnumbers = $params->{item_numbers};
2637     $opac = $params->{opac};
2638     $borcat = $params->{borcat} // q{};
2639
2640     $itemnumbers = [] unless defined $itemnumbers;
2641
2642     my $frameworkcode = GetFrameworkCode($biblionumber);
2643     _strip_item_fields($marc, $frameworkcode);
2644
2645     # ... and embed the current items
2646     my $dbh = C4::Context->dbh;
2647     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2648     $sth->execute($biblionumber);
2649     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2650
2651     my @item_fields; # Array holding the actual MARC data for items to be included.
2652     my @items;       # Array holding items which are both in the list (sitenumbers)
2653                      # and on this biblionumber
2654
2655     # Flag indicating if there is potential hiding.
2656     my $opachiddenitems = $opac
2657       && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2658
2659     require C4::Items;
2660     while ( my ($itemnumber) = $sth->fetchrow_array ) {
2661         next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2662         my $item;
2663         if ( $opachiddenitems ) {
2664             $item = Koha::Items->find($itemnumber);
2665             $item = $item ? $item->unblessed : undef;
2666         }
2667         push @items, { itemnumber => $itemnumber, item => $item };
2668     }
2669     my @items2pass = map { $_->{item} } @items;
2670     my @hiddenitems =
2671       $opachiddenitems
2672       ? C4::Items::GetHiddenItemnumbers({
2673             items  => \@items2pass,
2674             borcat => $borcat })
2675       : ();
2676     # Convert to a hash for quick searching
2677     my %hiddenitems = map { $_ => 1 } @hiddenitems;
2678     foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2679         next if $hiddenitems{$itemnumber};
2680         my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2681         push @item_fields, $item_marc->field($itemtag);
2682     }
2683     $marc->append_fields(@item_fields);
2684 }
2685
2686 =head1 INTERNAL FUNCTIONS
2687
2688 =head2 _koha_marc_update_bib_ids
2689
2690
2691   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2692
2693 Internal function to add or update biblionumber and biblioitemnumber to
2694 the MARC XML.
2695
2696 =cut
2697
2698 sub _koha_marc_update_bib_ids {
2699     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2700
2701     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
2702     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2703     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
2704     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2705
2706     if ( $biblio_tag < 10 ) {
2707         C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2708     } else {
2709         C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2710     }
2711     if ( $biblioitem_tag < 10 ) {
2712         C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2713     } else {
2714         C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2715     }
2716 }
2717
2718 =head2 _koha_marc_update_biblioitem_cn_sort
2719
2720   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2721
2722 Given a MARC bib record and the biblioitem hash, update the
2723 subfield that contains a copy of the value of biblioitems.cn_sort.
2724
2725 =cut
2726
2727 sub _koha_marc_update_biblioitem_cn_sort {
2728     my $marc          = shift;
2729     my $biblioitem    = shift;
2730     my $frameworkcode = shift;
2731
2732     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
2733     return unless $biblioitem_tag;
2734
2735     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2736
2737     if ( my $field = $marc->field($biblioitem_tag) ) {
2738         $field->delete_subfield( code => $biblioitem_subfield );
2739         if ( $cn_sort ne '' ) {
2740             $field->add_subfields( $biblioitem_subfield => $cn_sort );
2741         }
2742     } else {
2743
2744         # if we get here, no biblioitem tag is present in the MARC record, so
2745         # we'll create it if $cn_sort is not empty -- this would be
2746         # an odd combination of events, however
2747         if ($cn_sort) {
2748             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2749         }
2750     }
2751 }
2752
2753 =head2 _koha_add_biblio
2754
2755   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2756
2757 Internal function to add a biblio ($biblio is a hash with the values)
2758
2759 =cut
2760
2761 sub _koha_add_biblio {
2762     my ( $dbh, $biblio, $frameworkcode ) = @_;
2763
2764     my $error;
2765
2766     # set the series flag
2767     unless (defined $biblio->{'serial'}){
2768         $biblio->{'serial'} = 0;
2769         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
2770     }
2771
2772     my $query = "INSERT INTO biblio
2773         SET frameworkcode = ?,
2774             author = ?,
2775             title = ?,
2776             unititle =?,
2777             notes = ?,
2778             serial = ?,
2779             seriestitle = ?,
2780             copyrightdate = ?,
2781             datecreated=NOW(),
2782             abstract = ?
2783         ";
2784     my $sth = $dbh->prepare($query);
2785     $sth->execute(
2786         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
2787         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
2788     );
2789
2790     my $biblionumber = $dbh->{'mysql_insertid'};
2791     if ( $dbh->errstr ) {
2792         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
2793         warn $error;
2794     }
2795
2796     $sth->finish();
2797
2798     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2799     return ( $biblionumber, $error );
2800 }
2801
2802 =head2 _koha_modify_biblio
2803
2804   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2805
2806 Internal function for updating the biblio table
2807
2808 =cut
2809
2810 sub _koha_modify_biblio {
2811     my ( $dbh, $biblio, $frameworkcode ) = @_;
2812     my $error;
2813
2814     my $query = "
2815         UPDATE biblio
2816         SET    frameworkcode = ?,
2817                author = ?,
2818                title = ?,
2819                unititle = ?,
2820                notes = ?,
2821                serial = ?,
2822                seriestitle = ?,
2823                copyrightdate = ?,
2824                abstract = ?
2825         WHERE  biblionumber = ?
2826         "
2827       ;
2828     my $sth = $dbh->prepare($query);
2829
2830     $sth->execute(
2831         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
2832         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef, $biblio->{'abstract'}, $biblio->{'biblionumber'}
2833     ) if $biblio->{'biblionumber'};
2834
2835     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2836         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2837         warn $error;
2838     }
2839     return ( $biblio->{'biblionumber'}, $error );
2840 }
2841
2842 =head2 _koha_modify_biblioitem_nonmarc
2843
2844   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2845
2846 =cut
2847
2848 sub _koha_modify_biblioitem_nonmarc {
2849     my ( $dbh, $biblioitem ) = @_;
2850     my $error;
2851
2852     # re-calculate the cn_sort, it may have changed
2853     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2854
2855     my $query = "UPDATE biblioitems
2856     SET biblionumber    = ?,
2857         volume          = ?,
2858         number          = ?,
2859         itemtype        = ?,
2860         isbn            = ?,
2861         issn            = ?,
2862         publicationyear = ?,
2863         publishercode   = ?,
2864         volumedate      = ?,
2865         volumedesc      = ?,
2866         collectiontitle = ?,
2867         collectionissn  = ?,
2868         collectionvolume= ?,
2869         editionstatement= ?,
2870         editionresponsibility = ?,
2871         illus           = ?,
2872         pages           = ?,
2873         notes           = ?,
2874         size            = ?,
2875         place           = ?,
2876         lccn            = ?,
2877         url             = ?,
2878         cn_source       = ?,
2879         cn_class        = ?,
2880         cn_item         = ?,
2881         cn_suffix       = ?,
2882         cn_sort         = ?,
2883         totalissues     = ?,
2884         ean             = ?,
2885         agerestriction  = ?
2886         where biblioitemnumber = ?
2887         ";
2888     my $sth = $dbh->prepare($query);
2889     $sth->execute(
2890         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
2891         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
2892         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
2893         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2894         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
2895         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2896         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
2897         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
2898     );
2899     if ( $dbh->errstr ) {
2900         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2901         warn $error;
2902     }
2903     return ( $biblioitem->{'biblioitemnumber'}, $error );
2904 }
2905
2906 =head2 _koha_add_biblioitem
2907
2908   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
2909
2910 Internal function to add a biblioitem
2911
2912 =cut
2913
2914 sub _koha_add_biblioitem {
2915     my ( $dbh, $biblioitem ) = @_;
2916     my $error;
2917
2918     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2919     my $query = "INSERT INTO biblioitems SET
2920         biblionumber    = ?,
2921         volume          = ?,
2922         number          = ?,
2923         itemtype        = ?,
2924         isbn            = ?,
2925         issn            = ?,
2926         publicationyear = ?,
2927         publishercode   = ?,
2928         volumedate      = ?,
2929         volumedesc      = ?,
2930         collectiontitle = ?,
2931         collectionissn  = ?,
2932         collectionvolume= ?,
2933         editionstatement= ?,
2934         editionresponsibility = ?,
2935         illus           = ?,
2936         pages           = ?,
2937         notes           = ?,
2938         size            = ?,
2939         place           = ?,
2940         lccn            = ?,
2941         url             = ?,
2942         cn_source       = ?,
2943         cn_class        = ?,
2944         cn_item         = ?,
2945         cn_suffix       = ?,
2946         cn_sort         = ?,
2947         totalissues     = ?,
2948         ean             = ?,
2949         agerestriction  = ?
2950         ";
2951     my $sth = $dbh->prepare($query);
2952     $sth->execute(
2953         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
2954         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
2955         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
2956         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2957         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
2958         $biblioitem->{'lccn'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
2959         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
2960         $biblioitem->{'totalissues'},      $biblioitem->{'ean'},              $biblioitem->{'agerestriction'}
2961     );
2962     my $bibitemnum = $dbh->{'mysql_insertid'};
2963
2964     if ( $dbh->errstr ) {
2965         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
2966         warn $error;
2967     }
2968     $sth->finish();
2969     return ( $bibitemnum, $error );
2970 }
2971
2972 =head2 _koha_delete_biblio
2973
2974   $error = _koha_delete_biblio($dbh,$biblionumber);
2975
2976 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2977
2978 C<$dbh> - the database handle
2979
2980 C<$biblionumber> - the biblionumber of the biblio to be deleted
2981
2982 =cut
2983
2984 # FIXME: add error handling
2985
2986 sub _koha_delete_biblio {
2987     my ( $dbh, $biblionumber ) = @_;
2988
2989     # get all the data for this biblio
2990     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2991     $sth->execute($biblionumber);
2992
2993     # FIXME There is a transaction in _koha_delete_biblio_metadata
2994     # But actually all the following should be done inside a single transaction
2995     if ( my $data = $sth->fetchrow_hashref ) {
2996
2997         # save the record in deletedbiblio
2998         # find the fields to save
2999         my $query = "INSERT INTO deletedbiblio SET ";
3000         my @bind  = ();
3001         foreach my $temp ( keys %$data ) {
3002             $query .= "$temp = ?,";
3003             push( @bind, $data->{$temp} );
3004         }
3005
3006         # replace the last , by ",?)"
3007         $query =~ s/\,$//;
3008         my $bkup_sth = $dbh->prepare($query);
3009         $bkup_sth->execute(@bind);
3010         $bkup_sth->finish;
3011
3012         _koha_delete_biblio_metadata( $biblionumber );
3013
3014         # delete the biblio
3015         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3016         $sth2->execute($biblionumber);
3017         # update the timestamp (Bugzilla 7146)
3018         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3019         $sth2->execute($biblionumber);
3020         $sth2->finish;
3021     }
3022     $sth->finish;
3023     return;
3024 }
3025
3026 =head2 _koha_delete_biblioitems
3027
3028   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3029
3030 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3031
3032 C<$dbh> - the database handle
3033 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3034
3035 =cut
3036
3037 # FIXME: add error handling
3038
3039 sub _koha_delete_biblioitems {
3040     my ( $dbh, $biblioitemnumber ) = @_;
3041
3042     # get all the data for this biblioitem
3043     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3044     $sth->execute($biblioitemnumber);
3045
3046     if ( my $data = $sth->fetchrow_hashref ) {
3047
3048         # save the record in deletedbiblioitems
3049         # find the fields to save
3050         my $query = "INSERT INTO deletedbiblioitems SET ";
3051         my @bind  = ();
3052         foreach my $temp ( keys %$data ) {
3053             $query .= "$temp = ?,";
3054             push( @bind, $data->{$temp} );
3055         }
3056
3057         # replace the last , by ",?)"
3058         $query =~ s/\,$//;
3059         my $bkup_sth = $dbh->prepare($query);
3060         $bkup_sth->execute(@bind);
3061         $bkup_sth->finish;
3062
3063         # delete the biblioitem
3064         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3065         $sth2->execute($biblioitemnumber);
3066         # update the timestamp (Bugzilla 7146)
3067         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3068         $sth2->execute($biblioitemnumber);
3069         $sth2->finish;
3070     }
3071     $sth->finish;
3072     return;
3073 }
3074
3075 =head2 _koha_delete_biblio_metadata
3076
3077   $error = _koha_delete_biblio_metadata($biblionumber);
3078
3079 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3080
3081 =cut
3082
3083 sub _koha_delete_biblio_metadata {
3084     my ($biblionumber) = @_;
3085
3086     my $dbh    = C4::Context->dbh;
3087     my $schema = Koha::Database->new->schema;
3088     $schema->txn_do(
3089         sub {
3090             $dbh->do( q|
3091                 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
3092                 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
3093             |,  undef, $biblionumber );
3094             $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
3095                 undef, $biblionumber );
3096         }
3097     );
3098 }
3099
3100 =head1 UNEXPORTED FUNCTIONS
3101
3102 =head2 ModBiblioMarc
3103
3104   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3105
3106 Add MARC XML data for a biblio to koha
3107
3108 Function exported, but should NOT be used, unless you really know what you're doing
3109
3110 =cut
3111
3112 sub ModBiblioMarc {
3113     # pass the MARC::Record to this function, and it will create the records in
3114     # the marcxml field
3115     my ( $record, $biblionumber, $frameworkcode ) = @_;
3116     if ( !$record ) {
3117         carp 'ModBiblioMarc passed an undefined record';
3118         return;
3119     }
3120
3121     # Clone record as it gets modified
3122     $record = $record->clone();
3123     my $dbh    = C4::Context->dbh;
3124     my @fields = $record->fields();
3125     if ( !$frameworkcode ) {
3126         $frameworkcode = "";
3127     }
3128     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3129     $sth->execute( $frameworkcode, $biblionumber );
3130     $sth->finish;
3131     my $encoding = C4::Context->preference("marcflavour");
3132
3133     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3134     if ( $encoding eq "UNIMARC" ) {
3135         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3136         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3137         my $string = $record->subfield( 100, "a" );
3138         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3139             my $f100 = $record->field(100);
3140             $record->delete_field($f100);
3141         } else {
3142             $string = POSIX::strftime( "%Y%m%d", localtime );
3143             $string =~ s/\-//g;
3144             $string = sprintf( "%-*s", 35, $string );
3145             substr ( $string, 22, 3, $defaultlanguage);
3146         }
3147         substr( $string, 25, 3, "y50" );
3148         unless ( $record->subfield( 100, "a" ) ) {
3149             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3150         }
3151     }
3152
3153     #enhancement 5374: update transaction date (005) for marc21/unimarc
3154     if($encoding =~ /MARC21|UNIMARC/) {
3155       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3156         # YY MM DD HH MM SS (update year and month)
3157       my $f005= $record->field('005');
3158       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3159     }
3160
3161     my $metadata = {
3162         biblionumber => $biblionumber,
3163         format       => 'marcxml',
3164         schema       => C4::Context->preference('marcflavour'),
3165     };
3166     $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
3167
3168     my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
3169         Koha::Biblio::Metadata->new($metadata);
3170
3171     my $userenv = C4::Context->userenv;
3172     if ($userenv) {
3173         my $borrowernumber = $userenv->{number};
3174         my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
3175         unless ($m_rs->in_storage) {
3176             Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
3177             Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
3178         }
3179         Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
3180         Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
3181     }
3182
3183     $m_rs->metadata( $record->as_xml_record($encoding) );
3184     $m_rs->store;
3185
3186     ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
3187     return $biblionumber;
3188 }
3189
3190 =head2 CountBiblioInOrders
3191
3192     $count = &CountBiblioInOrders( $biblionumber);
3193
3194 This function return count of biblios in orders with $biblionumber
3195
3196 =cut
3197
3198 sub CountBiblioInOrders {
3199  my ($biblionumber) = @_;
3200     my $dbh            = C4::Context->dbh;
3201     my $query          = "SELECT count(*)
3202           FROM  aqorders
3203           WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3204     my $sth = $dbh->prepare($query);
3205     $sth->execute($biblionumber);
3206     my $count = $sth->fetchrow;
3207     return ($count);
3208 }
3209
3210 =head2 prepare_host_field
3211
3212 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3213 Generate the host item entry for an analytic child entry
3214
3215 =cut
3216
3217 sub prepare_host_field {
3218     my ( $hostbiblio, $marcflavour ) = @_;
3219     $marcflavour ||= C4::Context->preference('marcflavour');
3220     my $host = GetMarcBiblio({ biblionumber => $hostbiblio });
3221     # unfortunately as_string does not 'do the right thing'
3222     # if field returns undef
3223     my %sfd;
3224     my $field;
3225     my $host_field;
3226     if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3227         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3228             my $s = $field->as_string('ab');
3229             if ($s) {
3230                 $sfd{a} = $s;
3231             }
3232         }
3233         if ( $field = $host->field('245') ) {
3234             my $s = $field->as_string('a');
3235             if ($s) {
3236                 $sfd{t} = $s;
3237             }
3238         }
3239         if ( $field = $host->field('260') ) {
3240             my $s = $field->as_string('abc');
3241             if ($s) {
3242                 $sfd{d} = $s;
3243             }
3244         }
3245         if ( $field = $host->field('240') ) {
3246             my $s = $field->as_string();
3247             if ($s) {
3248                 $sfd{b} = $s;
3249             }
3250         }
3251         if ( $field = $host->field('022') ) {
3252             my $s = $field->as_string('a');
3253             if ($s) {
3254                 $sfd{x} = $s;
3255             }
3256         }
3257         if ( $field = $host->field('020') ) {
3258             my $s = $field->as_string('a');
3259             if ($s) {
3260                 $sfd{z} = $s;
3261             }
3262         }
3263         if ( $field = $host->field('001') ) {
3264             $sfd{w} = $field->data(),;
3265         }
3266         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3267         return $host_field;
3268     }
3269     elsif ( $marcflavour eq 'UNIMARC' ) {
3270         #author
3271         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3272             my $s = $field->as_string('ab');
3273             if ($s) {
3274                 $sfd{a} = $s;
3275             }
3276         }
3277         #title
3278         if ( $field = $host->field('200') ) {
3279             my $s = $field->as_string('a');
3280             if ($s) {
3281                 $sfd{t} = $s;
3282             }
3283         }
3284         #place of publicaton
3285         if ( $field = $host->field('210') ) {
3286             my $s = $field->as_string('a');
3287             if ($s) {
3288                 $sfd{c} = $s;
3289             }
3290         }
3291         #date of publication
3292         if ( $field = $host->field('210') ) {
3293             my $s = $field->as_string('d');
3294             if ($s) {
3295                 $sfd{d} = $s;
3296             }
3297         }
3298         #edition statement
3299         if ( $field = $host->field('205') ) {
3300             my $s = $field->as_string();
3301             if ($s) {
3302                 $sfd{e} = $s;
3303             }
3304         }
3305         #URL
3306         if ( $field = $host->field('856') ) {
3307             my $s = $field->as_string('u');
3308             if ($s) {
3309                 $sfd{u} = $s;
3310             }
3311         }
3312         #ISSN
3313         if ( $field = $host->field('011') ) {
3314             my $s = $field->as_string('a');
3315             if ($s) {
3316                 $sfd{x} = $s;
3317             }
3318         }
3319         #ISBN
3320         if ( $field = $host->field('010') ) {
3321             my $s = $field->as_string('a');
3322             if ($s) {
3323                 $sfd{y} = $s;
3324             }
3325         }
3326         if ( $field = $host->field('001') ) {
3327             $sfd{0} = $field->data(),;
3328         }
3329         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3330         return $host_field;
3331     }
3332     return;
3333 }
3334
3335
3336 =head2 UpdateTotalIssues
3337
3338   UpdateTotalIssues($biblionumber, $increase, [$value])
3339
3340 Update the total issue count for a particular bib record.
3341
3342 =over 4
3343
3344 =item C<$biblionumber> is the biblionumber of the bib to update
3345
3346 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3347
3348 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3349
3350 =back
3351
3352 =cut
3353
3354 sub UpdateTotalIssues {
3355     my ($biblionumber, $increase, $value) = @_;
3356     my $totalissues;
3357
3358     my $record = GetMarcBiblio({ biblionumber => $biblionumber });
3359     unless ($record) {
3360         carp "UpdateTotalIssues could not get biblio record";
3361         return;
3362     }
3363     my $biblio = Koha::Biblios->find( $biblionumber );
3364     unless ($biblio) {
3365         carp "UpdateTotalIssues could not get datas of biblio";
3366         return;
3367     }
3368     my $biblioitem = $biblio->biblioitem;
3369     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $biblio->frameworkcode);
3370     unless ($totalissuestag) {
3371         return 1; # There is nothing to do
3372     }
3373
3374     if (defined $value) {
3375         $totalissues = $value;
3376     } else {
3377         $totalissues = $biblioitem->totalissues + $increase;
3378     }
3379
3380      my $field = $record->field($totalissuestag);
3381      if (defined $field) {
3382          $field->update( $totalissuessubfield => $totalissues );
3383      } else {
3384          $field = MARC::Field->new($totalissuestag, '0', '0',
3385                  $totalissuessubfield => $totalissues);
3386          $record->insert_grouped_field($field);
3387      }
3388
3389      return ModBiblio($record, $biblionumber, $biblio->frameworkcode);
3390 }
3391
3392 =head2 RemoveAllNsb
3393
3394     &RemoveAllNsb($record);
3395
3396 Removes all nsb/nse chars from a record
3397
3398 =cut
3399
3400 sub RemoveAllNsb {
3401     my $record = shift;
3402     if (!$record) {
3403         carp 'RemoveAllNsb called with undefined record';
3404         return;
3405     }
3406
3407     SetUTF8Flag($record);
3408
3409     foreach my $field ($record->fields()) {
3410         if ($field->is_control_field()) {
3411             $field->update(nsb_clean($field->data()));
3412         } else {
3413             my @subfields = $field->subfields();
3414             my @new_subfields;
3415             foreach my $subfield (@subfields) {
3416                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3417             }
3418             if (scalar(@new_subfields) > 0) {
3419                 my $new_field;
3420                 eval {
3421                     $new_field = MARC::Field->new(
3422                         $field->tag(),
3423                         $field->indicator(1),
3424                         $field->indicator(2),
3425                         @new_subfields
3426                     );
3427                 };
3428                 if ($@) {
3429                     warn "error in RemoveAllNsb : $@";
3430                 } else {
3431                     $field->replace_with($new_field);
3432                 }
3433             }
3434         }
3435     }
3436
3437     return $record;
3438 }
3439
3440 1;
3441
3442
3443 __END__
3444
3445 =head1 AUTHOR
3446
3447 Koha Development Team <http://koha-community.org/>
3448
3449 Paul POULAIN paul.poulain@free.fr
3450
3451 Joshua Ferraro jmf@liblime.com
3452
3453 =cut