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