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