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