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