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