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