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