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,ind1_defaultvalue,ind2_defaultvalue
 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, $ind1_defaultvalue, $ind2_defaultvalue );
 916
 917     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue ) = $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     $res->{$tag}->{ind1_defaultvalue} = $ind1_defaultvalue;
 923     $res->{$tag}->{ind2_defaultvalue} = $ind2_defaultvalue;
 924     }
 925
 926     $sth = $dbh->prepare(
 927         "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
 928          FROM   marc_subfield_structure
 929          WHERE  frameworkcode=?
 930          ORDER BY tagfield,tagsubfield
 931         "
 932     );
 933
 934     $sth->execute($frameworkcode);
 935
 936     my $subfield;
 937     my $authorised_value;
 938     my $authtypecode;
 939     my $value_builder;
 940     my $kohafield;
 941     my $seealso;
 942     my $hidden;
 943     my $isurl;
 944     my $link;
 945     my $defaultvalue;
 946     my $maxlength;
 947
 948     while (
 949         (   $tag,          $subfield,      $liblibrarian, $libopac, $tab,    $mandatory, $repeatable, $authorised_value,
 950             $authtypecode, $value_builder, $kohafield,    $seealso, $hidden, $isurl,     $link,       $defaultvalue,
 951             $maxlength
 952         )
 953         = $sth->fetchrow
 954       ) {
 955         $res->{$tag}->{$subfield}->{lib}              = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
 956         $res->{$tag}->{$subfield}->{tab}              = $tab;
 957         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 958         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 959         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 960         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 961         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 962         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 963         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 964         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 965         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 966         $res->{$tag}->{$subfield}->{'link'}           = $link;
 967         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
 968         $res->{$tag}->{$subfield}->{maxlength}        = $maxlength;
 969     }
 970
 971     $cache->set_in_cache($cache_key, $res);
 972     return $res;
 973 }
 974
 975 =head2 GetUsedMarcStructure
 976
 977 The same function as GetMarcStructure except it just takes field
 978 in tab 0-9. (used field)
 979
 980   my $results = GetUsedMarcStructure($frameworkcode);
 981
 982 C<$results> is a ref to an array which each case contains a ref
 983 to a hash which each keys is the columns from marc_subfield_structure
 984
 985 C<$frameworkcode> is the framework code.
 986
 987 =cut
 988
 989 sub GetUsedMarcStructure {
 990     my $frameworkcode = shift || '';
 991     my $query = q{
 992         SELECT *
 993         FROM   marc_subfield_structure
 994         WHERE   tab > -1
 995             AND frameworkcode = ?
 996         ORDER BY tagfield, tagsubfield
 997     };
 998     my $sth = C4::Context->dbh->prepare($query);
 999     $sth->execute($frameworkcode);
1000     return $sth->fetchall_arrayref( {} );
1001 }
1002
1003 =head2 GetMarcSubfieldStructure
1004
1005 =cut
1006
1007 sub GetMarcSubfieldStructure {
1008     my ( $frameworkcode ) = @_;
1009
1010     $frameworkcode //= '';
1011
1012     my $cache     = Koha::Caches->get_instance();
1013     my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1014     my $cached    = $cache->get_from_cache($cache_key);
1015     return $cached if $cached;
1016
1017     my $dbh = C4::Context->dbh;
1018     # We moved to selectall_arrayref since selectall_hashref does not
1019     # keep duplicate mappings on kohafield (like place in 260 vs 264)
1020     my $subfield_aref = $dbh->selectall_arrayref( q|
1021         SELECT *
1022         FROM marc_subfield_structure
1023         WHERE frameworkcode = ?
1024         AND kohafield > ''
1025         ORDER BY frameworkcode,tagfield,tagsubfield
1026     |, { Slice => {} }, $frameworkcode );
1027     # Now map the output to a hash structure
1028     my $subfield_structure = {};
1029     foreach my $row ( @$subfield_aref ) {
1030         push @{ $subfield_structure->{ $row->{kohafield} }}, $row;
1031     }
1032     $cache->set_in_cache( $cache_key, $subfield_structure );
1033     return $subfield_structure;
1034 }
1035
1036 =head2 GetMarcFromKohaField
1037
1038     ( $field,$subfield ) = GetMarcFromKohaField( $kohafield );
1039     @fields = GetMarcFromKohaField( $kohafield );
1040     $field = GetMarcFromKohaField( $kohafield );
1041
1042     Returns the MARC fields & subfields mapped to $kohafield.
1043     Since the Default framework is considered as authoritative for such
1044     mappings, the former frameworkcode parameter is obsoleted.
1045
1046     In list context all mappings are returned; there can be multiple
1047     mappings. Note that in the above example you could miss a second
1048     mappings in the first call.
1049     In scalar context only the field tag of the first mapping is returned.
1050
1051 =cut
1052
1053 sub GetMarcFromKohaField {
1054     my ( $kohafield ) = @_;
1055     return unless $kohafield;
1056     # The next call uses the Default framework since it is AUTHORITATIVE
1057     # for all Koha to MARC mappings.
1058     my $mss = GetMarcSubfieldStructure( '' ); # Do not change framework
1059     my @retval;
1060     foreach( @{ $mss->{$kohafield} } ) {
1061         push @retval, $_->{tagfield}, $_->{tagsubfield};
1062     }
1063     return wantarray ? @retval : ( @retval ? $retval[0] : undef );
1064 }
1065
1066 =head2 GetMarcSubfieldStructureFromKohaField
1067
1068     my $str = GetMarcSubfieldStructureFromKohaField( $kohafield );
1069
1070     Returns marc subfield structure information for $kohafield.
1071     The Default framework is used, since it is authoritative for kohafield
1072     mappings.
1073     In list context returns a list of all hashrefs, since there may be
1074     multiple mappings. In scalar context the first hashref is returned.
1075
1076 =cut
1077
1078 sub GetMarcSubfieldStructureFromKohaField {
1079     my ( $kohafield ) = @_;
1080
1081     return unless $kohafield;
1082
1083     # The next call uses the Default framework since it is AUTHORITATIVE
1084     # for all Koha to MARC mappings.
1085     my $mss = GetMarcSubfieldStructure(''); # Do not change framework
1086     return unless $mss->{$kohafield};
1087     return wantarray ? @{$mss->{$kohafield}} : $mss->{$kohafield}->[0];
1088 }
1089
1090 =head2 GetMarcBiblio
1091
1092   my $record = GetMarcBiblio({
1093       biblionumber => $biblionumber,
1094       embed_items  => $embeditems,
1095       opac         => $opac });
1096
1097 Returns MARC::Record representing a biblio record, or C<undef> if the
1098 biblionumber doesn't exist.
1099
1100 Both embed_items and opac are optional.
1101 If embed_items is passed and is 1, items are embedded.
1102 If opac is passed and is 1, the record is filtered as needed.
1103
1104 =over 4
1105
1106 =item C<$biblionumber>
1107
1108 the biblionumber
1109
1110 =item C<$embeditems>
1111
1112 set to true to include item information.
1113
1114 =item C<$opac>
1115
1116 set to true to make the result suited for OPAC view. This causes things like
1117 OpacHiddenItems to be applied.
1118
1119 =back
1120
1121 =cut
1122
1123 sub GetMarcBiblio {
1124     my ($params) = @_;
1125
1126     if (not defined $params) {
1127         carp 'GetMarcBiblio called without parameters';
1128         return;
1129     }
1130
1131     my $biblionumber = $params->{biblionumber};
1132     my $embeditems   = $params->{embed_items} || 0;
1133     my $opac         = $params->{opac} || 0;
1134
1135     if (not defined $biblionumber) {
1136         carp 'GetMarcBiblio called with undefined biblionumber';
1137         return;
1138     }
1139
1140     my $dbh          = C4::Context->dbh;
1141     my $sth          = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=? ");
1142     $sth->execute($biblionumber);
1143     my $row     = $sth->fetchrow_hashref;
1144     my $biblioitemnumber = $row->{'biblioitemnumber'};
1145     my $marcxml = GetXmlBiblio( $biblionumber );
1146     $marcxml = StripNonXmlChars( $marcxml );
1147     my $frameworkcode = GetFrameworkCode($biblionumber);
1148     MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1149     my $record = MARC::Record->new();
1150
1151     if ($marcxml) {
1152         $record = eval {
1153             MARC::Record::new_from_xml( $marcxml, "utf8",
1154                 C4::Context->preference('marcflavour') );
1155         };
1156         if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1157         return unless $record;
1158
1159         C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1160             $biblioitemnumber );
1161         C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblionumber, undef, $opac )
1162           if ($embeditems);
1163
1164         return $record;
1165     }
1166     else {
1167         return;
1168     }
1169 }
1170
1171 =head2 GetXmlBiblio
1172
1173   my $marcxml = GetXmlBiblio($biblionumber);
1174
1175 Returns biblio_metadata.metadata/marcxml of the biblionumber passed in parameter.
1176 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1177
1178 =cut
1179
1180 sub GetXmlBiblio {
1181     my ($biblionumber) = @_;
1182     my $dbh = C4::Context->dbh;
1183     return unless $biblionumber;
1184     my ($marcxml) = $dbh->selectrow_array(
1185         q|
1186         SELECT metadata
1187         FROM biblio_metadata
1188         WHERE biblionumber=?
1189             AND format='marcxml'
1190             AND marcflavour=?
1191     |, undef, $biblionumber, C4::Context->preference('marcflavour')
1192     );
1193     return $marcxml;
1194 }
1195
1196 =head2 GetCOinSBiblio
1197
1198   my $coins = GetCOinSBiblio($record);
1199
1200 Returns the COinS (a span) which can be included in a biblio record
1201
1202 =cut
1203
1204 sub GetCOinSBiblio {
1205     my $record = shift;
1206
1207     # get the coin format
1208     if ( ! $record ) {
1209         carp 'GetCOinSBiblio called with undefined record';
1210         return;
1211     }
1212     my $pos7 = substr $record->leader(), 7, 1;
1213     my $pos6 = substr $record->leader(), 6, 1;
1214     my $mtx;
1215     my $genre;
1216     my ( $aulast, $aufirst ) = ( '', '' );
1217     my $oauthors  = '';
1218     my $title     = '';
1219     my $subtitle  = '';
1220     my $pubyear   = '';
1221     my $isbn      = '';
1222     my $issn      = '';
1223     my $publisher = '';
1224     my $pages     = '';
1225     my $titletype = 'b';
1226
1227     # For the purposes of generating COinS metadata, LDR/06-07 can be
1228     # considered the same for UNIMARC and MARC21
1229     my $fmts6;
1230     my $fmts7;
1231     %$fmts6 = (
1232                 'a' => 'book',
1233                 'b' => 'manuscript',
1234                 'c' => 'book',
1235                 'd' => 'manuscript',
1236                 'e' => 'map',
1237                 'f' => 'map',
1238                 'g' => 'film',
1239                 'i' => 'audioRecording',
1240                 'j' => 'audioRecording',
1241                 'k' => 'artwork',
1242                 'l' => 'document',
1243                 'm' => 'computerProgram',
1244                 'o' => 'document',
1245                 'r' => 'document',
1246             );
1247     %$fmts7 = (
1248                     'a' => 'journalArticle',
1249                     's' => 'journal',
1250               );
1251
1252     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1253
1254     if ( $genre eq 'book' ) {
1255             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1256     }
1257
1258     ##### We must transform mtx to a valable mtx and document type ####
1259     if ( $genre eq 'book' ) {
1260             $mtx = 'book';
1261     } elsif ( $genre eq 'journal' ) {
1262             $mtx = 'journal';
1263             $titletype = 'j';
1264     } elsif ( $genre eq 'journalArticle' ) {
1265             $mtx   = 'journal';
1266             $genre = 'article';
1267             $titletype = 'a';
1268     } else {
1269             $mtx = 'dc';
1270     }
1271
1272     $genre = ( $mtx eq 'dc' ) ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
1273
1274     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1275
1276         # Setting datas
1277         $aulast  = $record->subfield( '700', 'a' ) || '';
1278         $aufirst = $record->subfield( '700', 'b' ) || '';
1279         $oauthors = "&amp;rft.au=$aufirst $aulast";
1280
1281         # others authors
1282         if ( $record->field('200') ) {
1283             for my $au ( $record->field('200')->subfield('g') ) {
1284                 $oauthors .= "&amp;rft.au=$au";
1285             }
1286         }
1287         $title =
1288           ( $mtx eq 'dc' )
1289           ? "&amp;rft.title=" . $record->subfield( '200', 'a' )
1290           : "&amp;rft.title=" . $record->subfield( '200', 'a' ) . "&amp;rft.btitle=" . $record->subfield( '200', 'a' );
1291         $pubyear   = $record->subfield( '210', 'd' ) || '';
1292         $publisher = $record->subfield( '210', 'c' ) || '';
1293         $isbn      = $record->subfield( '010', 'a' ) || '';
1294         $issn      = $record->subfield( '011', 'a' ) || '';
1295     } else {
1296
1297         # MARC21 need some improve
1298
1299         # Setting datas
1300         if ( $record->field('100') ) {
1301             $oauthors .= "&amp;rft.au=" . $record->subfield( '100', 'a' );
1302         }
1303
1304         # others authors
1305         if ( $record->field('700') ) {
1306             for my $au ( $record->field('700')->subfield('a') ) {
1307                 $oauthors .= "&amp;rft.au=$au";
1308             }
1309         }
1310         $title = "&amp;rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1311         $subtitle = $record->subfield( '245', 'b' ) || '';
1312         $title .= $subtitle;
1313         if ($titletype eq 'a') {
1314             $pubyear   = $record->field('008') || '';
1315             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
1316             $isbn      = $record->subfield( '773', 'z' ) || '';
1317             $issn      = $record->subfield( '773', 'x' ) || '';
1318             if ($mtx eq 'journal') {
1319                 $title    .= "&amp;rft.title=" . ( $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{} );
1320             } else {
1321                 $title    .= "&amp;rft.btitle=" . ( $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{} );
1322             }
1323             foreach my $rel ($record->subfield( '773', 'g' )) {
1324                 if ($pages) {
1325                     $pages .= ', ';
1326                 }
1327                 $pages .= $rel;
1328             }
1329         } else {
1330             $pubyear   = $record->subfield( '260', 'c' ) || '';
1331             $publisher = $record->subfield( '260', 'b' ) || '';
1332             $isbn      = $record->subfield( '020', 'a' ) || '';
1333             $issn      = $record->subfield( '022', 'a' ) || '';
1334         }
1335
1336     }
1337     my $coins_value =
1338 "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";
1339     $coins_value =~ s/(\ |&[^a])/\+/g;
1340     $coins_value =~ s/\"/\&quot\;/g;
1341
1342 #<!-- 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="
1343
1344     return $coins_value;
1345 }
1346
1347
1348 =head2 GetMarcPrice
1349
1350 return the prices in accordance with the Marc format.
1351
1352 returns 0 if no price found
1353 returns undef if called without a marc record or with
1354 an unrecognized marc format
1355
1356 =cut
1357
1358 sub GetMarcPrice {
1359     my ( $record, $marcflavour ) = @_;
1360     if (!$record) {
1361         carp 'GetMarcPrice called on undefined record';
1362         return;
1363     }
1364
1365     my @listtags;
1366     my $subfield;
1367
1368     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1369         @listtags = ('345', '020');
1370         $subfield="c";
1371     } elsif ( $marcflavour eq "UNIMARC" ) {
1372         @listtags = ('345', '010');
1373         $subfield="d";
1374     } else {
1375         return;
1376     }
1377
1378     for my $field ( $record->field(@listtags) ) {
1379         for my $subfield_value  ($field->subfield($subfield)){
1380             #check value
1381             $subfield_value = MungeMarcPrice( $subfield_value );
1382             return $subfield_value if ($subfield_value);
1383         }
1384     }
1385     return 0; # no price found
1386 }
1387
1388 =head2 MungeMarcPrice
1389
1390 Return the best guess at what the actual price is from a price field.
1391
1392 =cut
1393
1394 sub MungeMarcPrice {
1395     my ( $price ) = @_;
1396     return unless ( $price =~ m/\d/ ); ## No digits means no price.
1397     # Look for the currency symbol and the normalized code of the active currency, if it's there,
1398     my $active_currency = Koha::Acquisition::Currencies->get_active;
1399     my $symbol = $active_currency->symbol;
1400     my $isocode = $active_currency->isocode;
1401     $isocode = $active_currency->currency unless defined $isocode;
1402     my $localprice;
1403     if ( $symbol ) {
1404         my @matches =($price=~ /
1405             \s?
1406             (                          # start of capturing parenthesis
1407             (?:
1408             (?:[\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'
1409             |(?:\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'
1410             )
1411             \s?\p{Sc}?\s?              # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1412             (?:
1413             (?:[\p{Sc}\p{L}\/.]){1,4}  # followed by same block as symbol block
1414             |(?:\d+[\p{P}\s]?){1,4}    # or by same block as digits block
1415             )
1416             \s?\p{L}{0,4}\s?           # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1417             )                          # end of capturing parenthesis
1418             (?:\p{P}|\z)               # followed by a punctuation sign or by the end of the string
1419             /gx);
1420
1421         if ( @matches ) {
1422             foreach ( @matches ) {
1423                 $localprice = $_ and last if index($_, $isocode)>=0;
1424             }
1425             if ( !$localprice ) {
1426                 foreach ( @matches ) {
1427                     $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1428                 }
1429             }
1430         }
1431     }
1432     if ( $localprice ) {
1433         $price = $localprice;
1434     } else {
1435         ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1436         ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1437     }
1438     # eliminate symbol/isocode, space and any final dot from the string
1439     $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1440     # remove comma,dot when used as separators from hundreds
1441     $price =~s/[\,\.](\d{3})/$1/g;
1442     # convert comma to dot to ensure correct display of decimals if existing
1443     $price =~s/,/./;
1444     return $price;
1445 }
1446
1447
1448 =head2 GetMarcQuantity
1449
1450 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1451 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1452
1453 returns 0 if no quantity found
1454 returns undef if called without a marc record or with
1455 an unrecognized marc format
1456
1457 =cut
1458
1459 sub GetMarcQuantity {
1460     my ( $record, $marcflavour ) = @_;
1461     if (!$record) {
1462         carp 'GetMarcQuantity called on undefined record';
1463         return;
1464     }
1465
1466     my @listtags;
1467     my $subfield;
1468
1469     if ( $marcflavour eq "MARC21" ) {
1470         return 0
1471     } elsif ( $marcflavour eq "UNIMARC" ) {
1472         @listtags = ('969');
1473         $subfield="a";
1474     } else {
1475         return;
1476     }
1477
1478     for my $field ( $record->field(@listtags) ) {
1479         for my $subfield_value  ($field->subfield($subfield)){
1480             #check value
1481             if ($subfield_value) {
1482                  # in France, the cents separator is the , but sometimes, ppl use a .
1483                  # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1484                 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1485                 return $subfield_value;
1486             }
1487         }
1488     }
1489     return 0; # no price found
1490 }
1491
1492
1493 =head2 GetAuthorisedValueDesc
1494
1495   my $subfieldvalue =get_authorised_value_desc(
1496     $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1497
1498 Retrieve the complete description for a given authorised value.
1499
1500 Now takes $category and $value pair too.
1501
1502   my $auth_value_desc =GetAuthorisedValueDesc(
1503     '','', 'DVD' ,'','','CCODE');
1504
1505 If the optional $opac parameter is set to a true value, displays OPAC
1506 descriptions rather than normal ones when they exist.
1507
1508 =cut
1509
1510 sub GetAuthorisedValueDesc {
1511     my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1512
1513     if ( !$category ) {
1514
1515         return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1516
1517         #---- branch
1518         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1519             return Koha::Libraries->find($value)->branchname;
1520         }
1521
1522         #---- itemtypes
1523         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1524             my $itemtype = Koha::ItemTypes->find( $value );
1525             return $itemtype ? $itemtype->translated_description : q||;
1526         }
1527
1528         #---- "true" authorized value
1529         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1530     }
1531
1532     my $dbh = C4::Context->dbh;
1533     if ( $category ne "" ) {
1534         my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1535         $sth->execute( $category, $value );
1536         my $data = $sth->fetchrow_hashref;
1537         return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1538     } else {
1539         return $value;    # if nothing is found return the original value
1540     }
1541 }
1542
1543 =head2 GetMarcControlnumber
1544
1545   $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1546
1547 Get the control number / record Identifier from the MARC record and return it.
1548
1549 =cut
1550
1551 sub GetMarcControlnumber {
1552     my ( $record, $marcflavour ) = @_;
1553     if (!$record) {
1554         carp 'GetMarcControlnumber called on undefined record';
1555         return;
1556     }
1557     my $controlnumber = "";
1558     # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1559     # Keep $marcflavour for possible later use
1560     if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1561         my $controlnumberField = $record->field('001');
1562         if ($controlnumberField) {
1563             $controlnumber = $controlnumberField->data();
1564         }
1565     }
1566     return $controlnumber;
1567 }
1568
1569 =head2 GetMarcISBN
1570
1571   $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1572
1573 Get all ISBNs from the MARC record and returns them in an array.
1574 ISBNs stored in different fields depending on MARC flavour
1575
1576 =cut
1577
1578 sub GetMarcISBN {
1579     my ( $record, $marcflavour ) = @_;
1580     if (!$record) {
1581         carp 'GetMarcISBN called on undefined record';
1582         return;
1583     }
1584     my $scope;
1585     if ( $marcflavour eq "UNIMARC" ) {
1586         $scope = '010';
1587     } else {    # assume marc21 if not unimarc
1588         $scope = '020';
1589     }
1590
1591     my @marcisbns;
1592     foreach my $field ( $record->field($scope) ) {
1593         my $isbn = $field->subfield( 'a' );
1594         if ( $isbn ne "" ) {
1595             push @marcisbns, $isbn;
1596         }
1597     }
1598
1599     return \@marcisbns;
1600 }    # end GetMarcISBN
1601
1602
1603 =head2 GetMarcISSN
1604
1605   $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1606
1607 Get all valid ISSNs from the MARC record and returns them in an array.
1608 ISSNs are stored in different fields depending on MARC flavour
1609
1610 =cut
1611
1612 sub GetMarcISSN {
1613     my ( $record, $marcflavour ) = @_;
1614     if (!$record) {
1615         carp 'GetMarcISSN called on undefined record';
1616         return;
1617     }
1618     my $scope;
1619     if ( $marcflavour eq "UNIMARC" ) {
1620         $scope = '011';
1621     }
1622     else {    # assume MARC21 or NORMARC
1623         $scope = '022';
1624     }
1625     my @marcissns;
1626     foreach my $field ( $record->field($scope) ) {
1627         push @marcissns, $field->subfield( 'a' )
1628             if ( $field->subfield( 'a' ) ne "" );
1629     }
1630     return \@marcissns;
1631 }    # end GetMarcISSN
1632
1633 =head2 GetMarcNotes
1634
1635     $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1636
1637     Get all notes from the MARC record and returns them in an array.
1638     The notes are stored in different fields depending on MARC flavour.
1639     MARC21 5XX $u subfields receive special attention as they are URIs.
1640
1641 =cut
1642
1643 sub GetMarcNotes {
1644     my ( $record, $marcflavour ) = @_;
1645     if (!$record) {
1646         carp 'GetMarcNotes called on undefined record';
1647         return;
1648     }
1649
1650     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1651     my @marcnotes;
1652     my %blacklist = map { $_ => 1 }
1653         split( /,/, C4::Context->preference('NotesBlacklist'));
1654     foreach my $field ( $record->field($scope) ) {
1655         my $tag = $field->tag();
1656         next if $blacklist{ $tag };
1657         if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) {
1658             # Field 5XX$u always contains URI
1659             # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u
1660             # We first push the other subfields, then all $u's separately
1661             # Leave further actions to the template (see e.g. opac-detail)
1662             my $othersub =
1663                 join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u'
1664             push @marcnotes, { marcnote => $field->as_string($othersub) };
1665             foreach my $sub ( $field->subfield('u') ) {
1666                 $sub =~ s/^\s+|\s+$//g; # trim
1667                 push @marcnotes, { marcnote => $sub };
1668             }
1669         } else {
1670             push @marcnotes, { marcnote => $field->as_string() };
1671         }
1672     }
1673     return \@marcnotes;
1674 }
1675
1676 =head2 GetMarcSubjects
1677
1678   $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1679
1680 Get all subjects from the MARC record and returns them in an array.
1681 The subjects are stored in different fields depending on MARC flavour
1682
1683 =cut
1684
1685 sub GetMarcSubjects {
1686     my ( $record, $marcflavour ) = @_;
1687     if (!$record) {
1688         carp 'GetMarcSubjects called on undefined record';
1689         return;
1690     }
1691     my ( $mintag, $maxtag, $fields_filter );
1692     if ( $marcflavour eq "UNIMARC" ) {
1693         $mintag = "600";
1694         $maxtag = "611";
1695         $fields_filter = '6..';
1696     } else { # marc21/normarc
1697         $mintag = "600";
1698         $maxtag = "699";
1699         $fields_filter = '6..';
1700     }
1701
1702     my @marcsubjects;
1703
1704     my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1705     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1706
1707     foreach my $field ( $record->field($fields_filter) ) {
1708         next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1709         my @subfields_loop;
1710         my @subfields = $field->subfields();
1711         my @link_loop;
1712
1713         # if there is an authority link, build the links with an= subfield9
1714         my $subfield9 = $field->subfield('9');
1715         my $authoritylink;
1716         if ($subfield9) {
1717             my $linkvalue = $subfield9;
1718             $linkvalue =~ s/(\(|\))//g;
1719             @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1720             $authoritylink = $linkvalue
1721         }
1722
1723         # other subfields
1724         for my $subject_subfield (@subfields) {
1725             next if ( $subject_subfield->[0] eq '9' );
1726
1727             # don't load unimarc subfields 3,4,5
1728             next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1729             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1730             next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1731
1732             my $code      = $subject_subfield->[0];
1733             my $value     = $subject_subfield->[1];
1734             my $linkvalue = $value;
1735             $linkvalue =~ s/(\(|\))//g;
1736             # if no authority link, build a search query
1737             unless ($subfield9) {
1738                 push @link_loop, {
1739                     limit    => $subject_limit,
1740                     'link'   => $linkvalue,
1741                     operator => (scalar @link_loop) ? ' and ' : undef
1742                 };
1743             }
1744             my @this_link_loop = @link_loop;
1745             # do not display $0
1746             unless ( $code eq '0' ) {
1747                 push @subfields_loop, {
1748                     code      => $code,
1749                     value     => $value,
1750                     link_loop => \@this_link_loop,
1751                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1752                 };
1753             }
1754         }
1755
1756         push @marcsubjects, {
1757             MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1758             authoritylink => $authoritylink,
1759         } if $authoritylink || @subfields_loop;
1760
1761     }
1762     return \@marcsubjects;
1763 }    #end getMARCsubjects
1764
1765 =head2 GetMarcAuthors
1766
1767   authors = GetMarcAuthors($record,$marcflavour);
1768
1769 Get all authors from the MARC record and returns them in an array.
1770 The authors are stored in different fields depending on MARC flavour
1771
1772 =cut
1773
1774 sub GetMarcAuthors {
1775     my ( $record, $marcflavour ) = @_;
1776     if (!$record) {
1777         carp 'GetMarcAuthors called on undefined record';
1778         return;
1779     }
1780     my ( $mintag, $maxtag, $fields_filter );
1781
1782     # tagslib useful only for UNIMARC author responsibilities
1783     my $tagslib;
1784     if ( $marcflavour eq "UNIMARC" ) {
1785         # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1786         $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
1787         $mintag = "700";
1788         $maxtag = "712";
1789         $fields_filter = '7..';
1790     } else { # marc21/normarc
1791         $mintag = "700";
1792         $maxtag = "720";
1793         $fields_filter = '7..';
1794     }
1795
1796     my @marcauthors;
1797     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1798
1799     foreach my $field ( $record->field($fields_filter) ) {
1800         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1801         my @subfields_loop;
1802         my @link_loop;
1803         my @subfields  = $field->subfields();
1804         my $count_auth = 0;
1805
1806         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1807         my $subfield9 = $field->subfield('9');
1808         if ($subfield9) {
1809             my $linkvalue = $subfield9;
1810             $linkvalue =~ s/(\(|\))//g;
1811             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1812         }
1813
1814         # other subfields
1815         my $unimarc3;
1816         for my $authors_subfield (@subfields) {
1817             next if ( $authors_subfield->[0] eq '9' );
1818
1819             # unimarc3 contains the $3 of the author for UNIMARC.
1820             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1821             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1822
1823             # don't load unimarc subfields 3, 5
1824             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1825
1826             my $code = $authors_subfield->[0];
1827             my $value        = $authors_subfield->[1];
1828             my $linkvalue    = $value;
1829             $linkvalue =~ s/(\(|\))//g;
1830             # UNIMARC author responsibility
1831             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1832                 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1833                 $linkvalue = "($value)";
1834             }
1835             # if no authority link, build a search query
1836             unless ($subfield9) {
1837                 push @link_loop, {
1838                     limit    => 'au',
1839                     'link'   => $linkvalue,
1840                     operator => (scalar @link_loop) ? ' and ' : undef
1841                 };
1842             }
1843             my @this_link_loop = @link_loop;
1844             # do not display $0
1845             unless ( $code eq '0') {
1846                 push @subfields_loop, {
1847                     tag       => $field->tag(),
1848                     code      => $code,
1849                     value     => $value,
1850                     link_loop => \@this_link_loop,
1851                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1852                 };
1853             }
1854         }
1855         push @marcauthors, {
1856             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1857             authoritylink => $subfield9,
1858             unimarc3 => $unimarc3
1859         };
1860     }
1861     return \@marcauthors;
1862 }
1863
1864 =head2 GetMarcUrls
1865
1866   $marcurls = GetMarcUrls($record,$marcflavour);
1867
1868 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1869 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1870
1871 =cut
1872
1873 sub GetMarcUrls {
1874     my ( $record, $marcflavour ) = @_;
1875     if (!$record) {
1876         carp 'GetMarcUrls called on undefined record';
1877         return;
1878     }
1879
1880     my @marcurls;
1881     for my $field ( $record->field('856') ) {
1882         my @notes;
1883         for my $note ( $field->subfield('z') ) {
1884             push @notes, { note => $note };
1885         }
1886         my @urls = $field->subfield('u');
1887         foreach my $url (@urls) {
1888             $url =~ s/^\s+|\s+$//g; # trim
1889             my $marcurl;
1890             if ( $marcflavour eq 'MARC21' ) {
1891                 my $s3   = $field->subfield('3');
1892                 my $link = $field->subfield('y');
1893                 unless ( $url =~ /^\w+:/ ) {
1894                     if ( $field->indicator(1) eq '7' ) {
1895                         $url = $field->subfield('2') . "://" . $url;
1896                     } elsif ( $field->indicator(1) eq '1' ) {
1897                         $url = 'ftp://' . $url;
1898                     } else {
1899
1900                         #  properly, this should be if ind1=4,
1901                         #  however we will assume http protocol since we're building a link.
1902                         $url = 'http://' . $url;
1903                     }
1904                 }
1905
1906                 # TODO handle ind 2 (relationship)
1907                 $marcurl = {
1908                     MARCURL => $url,
1909                     notes   => \@notes,
1910                 };
1911                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1912                 $marcurl->{'part'} = $s3 if ($link);
1913                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1914             } else {
1915                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1916                 $marcurl->{'MARCURL'} = $url;
1917             }
1918             push @marcurls, $marcurl;
1919         }
1920     }
1921     return \@marcurls;
1922 }
1923
1924 =head2 GetMarcSeries
1925
1926   $marcseriesarray = GetMarcSeries($record,$marcflavour);
1927
1928 Get all series from the MARC record and returns them in an array.
1929 The series are stored in different fields depending on MARC flavour
1930
1931 =cut
1932
1933 sub GetMarcSeries {
1934     my ( $record, $marcflavour ) = @_;
1935     if (!$record) {
1936         carp 'GetMarcSeries called on undefined record';
1937         return;
1938     }
1939
1940     my ( $mintag, $maxtag, $fields_filter );
1941     if ( $marcflavour eq "UNIMARC" ) {
1942         $mintag = "225";
1943         $maxtag = "225";
1944         $fields_filter = '2..';
1945     } else {    # marc21/normarc
1946         $mintag = "440";
1947         $maxtag = "490";
1948         $fields_filter = '4..';
1949     }
1950
1951     my @marcseries;
1952     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1953
1954     foreach my $field ( $record->field($fields_filter) ) {
1955         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1956         my @subfields_loop;
1957         my @subfields = $field->subfields();
1958         my @link_loop;
1959
1960         for my $series_subfield (@subfields) {
1961
1962             # ignore $9, used for authority link
1963             next if ( $series_subfield->[0] eq '9' );
1964
1965             my $volume_number;
1966             my $code      = $series_subfield->[0];
1967             my $value     = $series_subfield->[1];
1968             my $linkvalue = $value;
1969             $linkvalue =~ s/(\(|\))//g;
1970
1971             # see if this is an instance of a volume
1972             if ( $code eq 'v' ) {
1973                 $volume_number = 1;
1974             }
1975
1976             push @link_loop, {
1977                 'link' => $linkvalue,
1978                 operator => (scalar @link_loop) ? ' and ' : undef
1979             };
1980
1981             if ($volume_number) {
1982                 push @subfields_loop, { volumenum => $value };
1983             } else {
1984                 push @subfields_loop, {
1985                     code      => $code,
1986                     value     => $value,
1987                     link_loop => \@link_loop,
1988                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
1989                     volumenum => $volume_number,
1990                 }
1991             }
1992         }
1993         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1994
1995     }
1996     return \@marcseries;
1997 }    #end getMARCseriess
1998
1999 =head2 GetMarcHosts
2000
2001   $marchostsarray = GetMarcHosts($record,$marcflavour);
2002
2003 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2004
2005 =cut
2006
2007 sub GetMarcHosts {
2008     my ( $record, $marcflavour ) = @_;
2009     if (!$record) {
2010         carp 'GetMarcHosts called on undefined record';
2011         return;
2012     }
2013
2014     my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2015     $marcflavour ||="MARC21";
2016     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2017         $tag = "773";
2018         $title_subf = "t";
2019         $bibnumber_subf ="0";
2020         $itemnumber_subf='9';
2021     }
2022     elsif ($marcflavour eq "UNIMARC") {
2023         $tag = "461";
2024         $title_subf = "t";
2025         $bibnumber_subf ="0";
2026         $itemnumber_subf='9';
2027     };
2028
2029     my @marchosts;
2030
2031     foreach my $field ( $record->field($tag)) {
2032
2033         my @fields_loop;
2034
2035         my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2036         my $hosttitle = $field->subfield($title_subf);
2037         my $hostitemnumber=$field->subfield($itemnumber_subf);
2038         push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2039         push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2040
2041         }
2042     my $marchostsarray = \@marchosts;
2043     return $marchostsarray;
2044 }
2045
2046 =head2 UpsertMarcSubfield
2047
2048     my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
2049
2050 =cut
2051
2052 sub UpsertMarcSubfield {
2053     my ($record, $tag, $code, $content) = @_;
2054     my $f = $record->field($tag);
2055
2056     if ($f) {
2057         $f->update( $code => $content );
2058     }
2059     else {
2060         my $f = MARC::Field->new( $tag, '', '', $code => $content);
2061         $record->insert_fields_ordered( $f );
2062     }
2063 }
2064
2065 =head2 UpsertMarcControlField
2066
2067     my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
2068
2069 =cut
2070
2071 sub UpsertMarcControlField {
2072     my ($record, $tag, $content) = @_;
2073     die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
2074     my $f = $record->field($tag);
2075
2076     if ($f) {
2077         $f->update( $content );
2078     }
2079     else {
2080         my $f = MARC::Field->new($tag, $content);
2081         $record->insert_fields_ordered( $f );
2082     }
2083 }
2084
2085 =head2 GetFrameworkCode
2086
2087   $frameworkcode = GetFrameworkCode( $biblionumber )
2088
2089 =cut
2090
2091 sub GetFrameworkCode {
2092     my ($biblionumber) = @_;
2093     my $dbh            = C4::Context->dbh;
2094     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2095     $sth->execute($biblionumber);
2096     my ($frameworkcode) = $sth->fetchrow;
2097     return $frameworkcode;
2098 }
2099
2100 =head2 TransformKohaToMarc
2101
2102     $record = TransformKohaToMarc( $hash [, $params ]  )
2103
2104 This function builds a (partial) MARC::Record from a hash.
2105 Hash entries can be from biblio, biblioitems or items.
2106 The params hash includes the parameter no_split used in C4::Items.
2107
2108 This function is called in acquisition module, to create a basic catalogue
2109 entry from user entry.
2110
2111 =cut
2112
2113
2114 sub TransformKohaToMarc {
2115     my ( $hash, $params ) = @_;
2116     my $record = MARC::Record->new();
2117     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2118
2119     # In the next call we use the Default framework, since it is considered
2120     # authoritative for Koha to Marc mappings.
2121     my $mss = GetMarcSubfieldStructure( '' ); # do not change framework
2122     my $tag_hr = {};
2123     while ( my ($kohafield, $value) = each %$hash ) {
2124         foreach my $fld ( @{ $mss->{$kohafield} } ) {
2125             my $tagfield    = $fld->{tagfield};
2126             my $tagsubfield = $fld->{tagsubfield};
2127             next if !$tagfield;
2128             my @values = $params->{no_split}
2129                 ? ( $value )
2130                 : split(/\s?\|\s?/, $value, -1);
2131             foreach my $value ( @values ) {
2132                 next if $value eq '';
2133                 $tag_hr->{$tagfield} //= [];
2134                 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
2135             }
2136         }
2137     }
2138     foreach my $tag (sort keys %$tag_hr) {
2139         my @sfl = @{$tag_hr->{$tag}};
2140         @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2141         @sfl = map { @{$_}; } @sfl;
2142         # Special care for control fields: remove the subfield indication @
2143         # and do not insert indicators.
2144         my @ind = $tag < 10 ? () : ( " ", " " );
2145         @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
2146         $record->insert_fields_ordered( MARC::Field->new($tag, @ind, @sfl) );
2147     }
2148     return $record;
2149 }
2150
2151 =head2 PrepHostMarcField
2152
2153     $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2154
2155 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2156
2157 =cut
2158
2159 sub PrepHostMarcField {
2160     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2161     $marcflavour ||="MARC21";
2162
2163     require C4::Items;
2164     my $hostrecord = GetMarcBiblio({ biblionumber => $hostbiblionumber });
2165         my $item = C4::Items::GetItem($hostitemnumber);
2166
2167         my $hostmarcfield;
2168     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2169
2170         #main entry
2171         my $mainentry;
2172         if ($hostrecord->subfield('100','a')){
2173             $mainentry = $hostrecord->subfield('100','a');
2174         } elsif ($hostrecord->subfield('110','a')){
2175             $mainentry = $hostrecord->subfield('110','a');
2176         } else {
2177             $mainentry = $hostrecord->subfield('111','a');
2178         }
2179
2180         # qualification info
2181         my $qualinfo;
2182         if (my $field260 = $hostrecord->field('260')){
2183             $qualinfo =  $field260->as_string( 'abc' );
2184         }
2185
2186
2187         #other fields
2188         my $ed = $hostrecord->subfield('250','a');
2189         my $barcode = $item->{'barcode'};
2190         my $title = $hostrecord->subfield('245','a');
2191
2192         # record control number, 001 with 003 and prefix
2193         my $recctrlno;
2194         if ($hostrecord->field('001')){
2195             $recctrlno = $hostrecord->field('001')->data();
2196             if ($hostrecord->field('003')){
2197                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2198             }
2199         }
2200
2201         # issn/isbn
2202         my $issn = $hostrecord->subfield('022','a');
2203         my $isbn = $hostrecord->subfield('020','a');
2204
2205
2206         $hostmarcfield = MARC::Field->new(
2207                 773, '0', '',
2208                 '0' => $hostbiblionumber,
2209                 '9' => $hostitemnumber,
2210                 'a' => $mainentry,
2211                 'b' => $ed,
2212                 'd' => $qualinfo,
2213                 'o' => $barcode,
2214                 't' => $title,
2215                 'w' => $recctrlno,
2216                 'x' => $issn,
2217                 'z' => $isbn
2218                 );
2219     } elsif ($marcflavour eq "UNIMARC") {
2220         $hostmarcfield = MARC::Field->new(
2221             461, '', '',
2222             '0' => $hostbiblionumber,
2223             't' => $hostrecord->subfield('200','a'),
2224             '9' => $hostitemnumber
2225         );
2226     };
2227
2228     return $hostmarcfield;
2229 }
2230
2231 =head2 TransformHtmlToXml
2232
2233   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2234                              $ind_tag, $auth_type )
2235
2236 $auth_type contains :
2237
2238 =over
2239
2240 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2241
2242 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2243
2244 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2245
2246 =back
2247
2248 =cut
2249
2250 sub TransformHtmlToXml {
2251     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2252     # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2253
2254     my $xml = MARC::File::XML::header('UTF-8');
2255     $xml .= "<record>\n";
2256     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2257     MARC::File::XML->default_record_format($auth_type);
2258
2259     # in UNIMARC, field 100 contains the encoding
2260     # check that there is one, otherwise the
2261     # MARC::Record->new_from_xml will fail (and Koha will die)
2262     my $unimarc_and_100_exist = 0;
2263     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
2264     my $prevvalue;
2265     my $prevtag = -1;
2266     my $first   = 1;
2267     my $j       = -1;
2268     my $close_last_tag;
2269     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2270
2271         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2272
2273             # if we have a 100 field and it's values are not correct, skip them.
2274             # if we don't have any valid 100 field, we will create a default one at the end
2275             my $enc = substr( @$values[$i], 26, 2 );
2276             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2277                 $unimarc_and_100_exist = 1;
2278             } else {
2279                 next;
2280             }
2281         }
2282         @$values[$i] =~ s/&/&amp;/g;
2283         @$values[$i] =~ s/</&lt;/g;
2284         @$values[$i] =~ s/>/&gt;/g;
2285         @$values[$i] =~ s/"/&quot;/g;
2286         @$values[$i] =~ s/'/&apos;/g;
2287
2288         if ( ( @$tags[$i] ne $prevtag ) ) {
2289             $close_last_tag = 0;
2290             $j++ unless ( @$tags[$i] eq "" );
2291             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2292             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2293             my $ind1       = _default_ind_to_space($indicator1);
2294             my $ind2;
2295             if ( @$indicator[$j] ) {
2296                 $ind2 = _default_ind_to_space($indicator2);
2297             } else {
2298                 warn "Indicator in @$tags[$i] is empty";
2299                 $ind2 = " ";
2300             }
2301             if ( !$first ) {
2302                 $xml .= "</datafield>\n";
2303                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2304                     && ( @$values[$i] ne "" ) ) {
2305                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2306                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2307                     $first = 0;
2308                     $close_last_tag = 1;
2309                 } else {
2310                     $first = 1;
2311                 }
2312             } else {
2313                 if ( @$values[$i] ne "" ) {
2314
2315                     # leader
2316                     if ( @$tags[$i] eq "000" ) {
2317                         $xml .= "<leader>@$values[$i]</leader>\n";
2318                         $first = 1;
2319
2320                         # rest of the fixed fields
2321                     } elsif ( @$tags[$i] < 10 ) {
2322                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2323                         $first = 1;
2324                     } else {
2325                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2326                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2327                         $first = 0;
2328                         $close_last_tag = 1;
2329                     }
2330                 }
2331             }
2332         } else {    # @$tags[$i] eq $prevtag
2333             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2334             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2335             my $ind1       = _default_ind_to_space($indicator1);
2336             my $ind2;
2337             if ( @$indicator[$j] ) {
2338                 $ind2 = _default_ind_to_space($indicator2);
2339             } else {
2340                 warn "Indicator in @$tags[$i] is empty";
2341                 $ind2 = " ";
2342             }
2343             if ( @$values[$i] eq "" ) {
2344             } else {
2345                 if ($first) {
2346                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2347                     $first = 0;
2348                     $close_last_tag = 1;
2349                 }
2350                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2351             }
2352         }
2353         $prevtag = @$tags[$i];
2354     }
2355     $xml .= "</datafield>\n" if $close_last_tag;
2356     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2357
2358         #     warn "SETTING 100 for $auth_type";
2359         my $string = strftime( "%Y%m%d", localtime(time) );
2360
2361         # set 50 to position 26 is biblios, 13 if authorities
2362         my $pos = 26;
2363         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2364         $string = sprintf( "%-*s", 35, $string );
2365         substr( $string, $pos, 6, "50" );
2366         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2367         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2368         $xml .= "</datafield>\n";
2369     }
2370     $xml .= "</record>\n";
2371     $xml .= MARC::File::XML::footer();
2372     return $xml;
2373 }
2374
2375 =head2 _default_ind_to_space
2376
2377 Passed what should be an indicator returns a space
2378 if its undefined or zero length
2379
2380 =cut
2381
2382 sub _default_ind_to_space {
2383     my $s = shift;
2384     if ( !defined $s || $s eq q{} ) {
2385         return ' ';
2386     }
2387     return $s;
2388 }
2389
2390 =head2 TransformHtmlToMarc
2391
2392     L<$record> = TransformHtmlToMarc(L<$cgi>)
2393     L<$cgi> is the CGI object which contains the values for subfields
2394     {
2395         'tag_010_indicator1_531951' ,
2396         'tag_010_indicator2_531951' ,
2397         'tag_010_code_a_531951_145735' ,
2398         'tag_010_subfield_a_531951_145735' ,
2399         'tag_200_indicator1_873510' ,
2400         'tag_200_indicator2_873510' ,
2401         'tag_200_code_a_873510_673465' ,
2402         'tag_200_subfield_a_873510_673465' ,
2403         'tag_200_code_b_873510_704318' ,
2404         'tag_200_subfield_b_873510_704318' ,
2405         'tag_200_code_e_873510_280822' ,
2406         'tag_200_subfield_e_873510_280822' ,
2407         'tag_200_code_f_873510_110730' ,
2408         'tag_200_subfield_f_873510_110730' ,
2409     }
2410     L<$record> is the MARC::Record object.
2411
2412 =cut
2413
2414 sub TransformHtmlToMarc {
2415     my ($cgi, $isbiblio) = @_;
2416
2417     my @params = $cgi->multi_param();
2418
2419     # explicitly turn on the UTF-8 flag for all
2420     # 'tag_' parameters to avoid incorrect character
2421     # conversion later on
2422     my $cgi_params = $cgi->Vars;
2423     foreach my $param_name ( keys %$cgi_params ) {
2424         if ( $param_name =~ /^tag_/ ) {
2425             my $param_value = $cgi_params->{$param_name};
2426             unless ( Encode::is_utf8( $param_value ) ) {
2427                 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2428             }
2429         }
2430     }
2431
2432     # creating a new record
2433     my $record = MARC::Record->new();
2434     my @fields;
2435     my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2436     ($biblionumbertagfield, $biblionumbertagsubfield) =
2437         &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2438 #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!
2439     for (my $i = 0; $params[$i]; $i++ ) {    # browse all CGI params
2440         my $param    = $params[$i];
2441         my $newfield = 0;
2442
2443         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2444         if ( $param eq 'biblionumber' ) {
2445             if ( $biblionumbertagfield < 10 ) {
2446                 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2447             } else {
2448                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2449             }
2450             push @fields, $newfield if ($newfield);
2451         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2452             my $tag = $1;
2453
2454             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2455             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2456             $newfield = 0;
2457             my $j = $i + 2;
2458
2459             if ( $tag < 10 ) {                              # no code for theses fields
2460                                                             # in MARC editor, 000 contains the leader.
2461                 next if $tag == $biblionumbertagfield;
2462                 my $fval= $cgi->param($params[$j+1]);
2463                 if ( $tag eq '000' ) {
2464                     # Force a fake leader even if not provided to avoid crashing
2465                     # during decoding MARC record containing UTF-8 characters
2466                     $record->leader(
2467                         length( $fval ) == 24
2468                         ? $fval
2469                         : '     nam a22        4500'
2470                         )
2471                     ;
2472                     # between 001 and 009 (included)
2473                 } elsif ( $fval ne '' ) {
2474                     $newfield = MARC::Field->new( $tag, $fval, );
2475                 }
2476
2477                 # > 009, deal with subfields
2478             } else {
2479                 # browse subfields for this tag (reason for _code_ match)
2480                 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2481                     last unless defined $params[$j+1];
2482                     $j += 2 and next
2483                         if $tag == $biblionumbertagfield and
2484                            $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2485                     #if next param ne subfield, then it was probably empty
2486                     #try next param by incrementing j
2487                     if($params[$j+1]!~/_subfield_/) {$j++; next; }
2488                     my $fkey= $cgi->param($params[$j]);
2489                     my $fval= $cgi->param($params[$j+1]);
2490                     #check if subfield value not empty and field exists
2491                     if($fval ne '' && $newfield) {
2492                         $newfield->add_subfields( $fkey => $fval);
2493                     }
2494                     elsif($fval ne '') {
2495                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2496                     }
2497                     $j += 2;
2498                 } #end-of-while
2499                 $i= $j-1; #update i for outer loop accordingly
2500             }
2501             push @fields, $newfield if ($newfield);
2502         }
2503     }
2504
2505     $record->append_fields(@fields);
2506     return $record;
2507 }
2508
2509 =head2 TransformMarcToKoha
2510
2511     $result = TransformMarcToKoha( $record, undef, $limit )
2512
2513 Extract data from a MARC bib record into a hashref representing
2514 Koha biblio, biblioitems, and items fields.
2515
2516 If passed an undefined record will log the error and return an empty
2517 hash_ref.
2518
2519 =cut
2520
2521 sub TransformMarcToKoha {
2522     my ( $record, $frameworkcode, $limit_table ) = @_;
2523     # FIXME  Parameter $frameworkcode is obsolete and will be removed
2524     $limit_table //= q{};
2525
2526     my $result = {};
2527     if (!defined $record) {
2528         carp('TransformMarcToKoha called with undefined record');
2529         return $result;
2530     }
2531
2532     my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2533     if( $limit_table eq 'items' ) {
2534         %tables = ( items => 1 );
2535     }
2536
2537     # The next call acknowledges Default as the authoritative framework
2538     # for Koha to MARC mappings.
2539     my $mss = GetMarcSubfieldStructure(''); # Do not change framework
2540     foreach my $kohafield ( keys %{ $mss } ) {
2541         my ( $table, $column ) = split /[.]/, $kohafield, 2;
2542         next unless $tables{$table};
2543         my $val = TransformMarcToKohaOneField( $kohafield, $record );
2544         next if !defined $val;
2545         my $key = _disambiguate( $table, $column );
2546         $result->{$key} = $val;
2547     }
2548     return $result;
2549 }
2550
2551 =head2 _disambiguate
2552
2553   $newkey = _disambiguate($table, $field);
2554
2555 This is a temporary hack to distinguish between the
2556 following sets of columns when using TransformMarcToKoha.
2557
2558   items.cn_source & biblioitems.cn_source
2559   items.cn_sort & biblioitems.cn_sort
2560
2561 Columns that are currently NOT distinguished (FIXME
2562 due to lack of time to fully test) are:
2563
2564   biblio.notes and biblioitems.notes
2565   biblionumber
2566   timestamp
2567   biblioitemnumber
2568
2569 FIXME - this is necessary because prefixing each column
2570 name with the table name would require changing lots
2571 of code and templates, and exposing more of the DB
2572 structure than is good to the UI templates, particularly
2573 since biblio and bibloitems may well merge in a future
2574 version.  In the future, it would also be good to
2575 separate DB access and UI presentation field names
2576 more.
2577
2578 =cut
2579
2580 sub _disambiguate {
2581     my ( $table, $column ) = @_;
2582     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2583         return $table . '.' . $column;
2584     } else {
2585         return $column;
2586     }
2587
2588 }
2589
2590 =head2 TransformMarcToKohaOneField
2591
2592     $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2593
2594     Note: The authoritative Default framework is used implicitly.
2595
2596 =cut
2597
2598 sub TransformMarcToKohaOneField {
2599     my ( $kohafield, $marc ) = @_;
2600
2601     my ( @rv, $retval );
2602     my @mss = GetMarcSubfieldStructureFromKohaField($kohafield);
2603     foreach my $fldhash ( @mss ) {
2604         my $tag = $fldhash->{tagfield};
2605         my $sub = $fldhash->{tagsubfield};
2606         foreach my $fld ( $marc->field($tag) ) {
2607             if( $sub eq '@' || $fld->is_control_field ) {
2608                 push @rv, $fld->data if $fld->data;
2609             } else {
2610                 push @rv, grep { $_ } $fld->subfield($sub);
2611             }
2612         }
2613     }
2614     return unless @rv;
2615     $retval = join ' | ', uniq(@rv);
2616
2617     # Additional polishing for individual kohafields
2618     if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2619         $retval = _adjust_pubyear( $retval );
2620     }
2621
2622     return $retval;
2623 }
2624
2625 =head2 _adjust_pubyear
2626
2627     Helper routine for TransformMarcToKohaOneField
2628
2629 =cut
2630
2631 sub _adjust_pubyear {
2632     my $retval = shift;
2633     # modify return value to keep only the 1st year found
2634     if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2635         $retval = $1;
2636     } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2637         $retval = $1;
2638     } elsif( $retval =~ m/
2639              (?<year>\d)[-]?[.Xx?]{3}
2640             |(?<year>\d{2})[.Xx?]{2}
2641             |(?<year>\d{3})[.Xx?]
2642             |(?<year>\d)[-]{3}\?
2643             |(?<year>\d\d)[-]{2}\?
2644             |(?<year>\d{3})[-]\?
2645     /xms ) { # the form 198-? occurred in Dutch ISBD rules
2646         my $digits = $+{year};
2647         $retval = $digits * ( 10 ** ( 4 - length($digits) ));
2648     }
2649     return $retval;
2650 }
2651
2652 =head2 CountItemsIssued
2653
2654     my $count = CountItemsIssued( $biblionumber );
2655
2656 =cut
2657
2658 sub CountItemsIssued {
2659     my ($biblionumber) = @_;
2660     my $dbh            = C4::Context->dbh;
2661     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2662     $sth->execute($biblionumber);
2663     my $row = $sth->fetchrow_hashref();
2664     return $row->{'issuedCount'};
2665 }
2666
2667 =head2 ModZebra
2668
2669   ModZebra( $biblionumber, $op, $server, $record );
2670
2671 $biblionumber is the biblionumber we want to index
2672
2673 $op is specialUpdate or recordDelete, and is used to know what we want to do
2674
2675 $server is the server that we want to update
2676
2677 $record is the update MARC record if it's available. If it's not supplied
2678 and is needed, it'll be loaded from the database.
2679
2680 =cut
2681
2682 sub ModZebra {
2683 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2684     my ( $biblionumber, $op, $server, $record ) = @_;
2685     $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2686     if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
2687
2688         # TODO abstract to a standard API that'll work for whatever
2689         require Koha::SearchEngine::Elasticsearch::Indexer;
2690         my $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
2691             {
2692                 index => $server eq 'biblioserver'
2693                 ? $Koha::SearchEngine::BIBLIOS_INDEX
2694                 : $Koha::SearchEngine::AUTHORITIES_INDEX
2695             }
2696         );
2697         if ( $op eq 'specialUpdate' ) {
2698             unless ($record) {
2699                 $record = GetMarcBiblio({
2700                     biblionumber => $biblionumber,
2701                     embed_items  => 1 });
2702             }
2703             my $records = [$record];
2704             $indexer->update_index_background( [$biblionumber], [$record] );
2705         }
2706         elsif ( $op eq 'recordDelete' ) {
2707             $indexer->delete_index_background( [$biblionumber] );
2708         }
2709         else {
2710             croak "ModZebra called with unknown operation: $op";
2711         }
2712     }
2713
2714     my $dbh = C4::Context->dbh;
2715
2716     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2717     # at the same time
2718     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2719     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2720     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2721     WHERE server = ?
2722         AND   biblio_auth_number = ?
2723         AND   operation = ?
2724         AND   done = 0";
2725     my $check_sth = $dbh->prepare_cached($check_sql);
2726     $check_sth->execute( $server, $biblionumber, $op );
2727     my ($count) = $check_sth->fetchrow_array;
2728     $check_sth->finish();
2729     if ( $count == 0 ) {
2730         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2731         $sth->execute( $biblionumber, $server, $op );
2732         $sth->finish;
2733     }
2734 }
2735
2736
2737 =head2 EmbedItemsInMarcBiblio
2738
2739     EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers, $opac);
2740
2741 Given a MARC::Record object containing a bib record,
2742 modify it to include the items attached to it as 9XX
2743 per the bib's MARC framework.
2744 if $itemnumbers is defined, only specified itemnumbers are embedded.
2745
2746 If $opac is true, then opac-relevant suppressions are included.
2747
2748 =cut
2749
2750 sub EmbedItemsInMarcBiblio {
2751     my ($marc, $biblionumber, $itemnumbers, $opac) = @_;
2752     if ( !$marc ) {
2753         carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2754         return;
2755     }
2756
2757     $itemnumbers = [] unless defined $itemnumbers;
2758
2759     my $frameworkcode = GetFrameworkCode($biblionumber);
2760     _strip_item_fields($marc, $frameworkcode);
2761
2762     # ... and embed the current items
2763     my $dbh = C4::Context->dbh;
2764     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2765     $sth->execute($biblionumber);
2766     my @item_fields;
2767     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2768     my @items;
2769     my $opachiddenitems = $opac
2770       && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2771     require C4::Items;
2772     while ( my ($itemnumber) = $sth->fetchrow_array ) {
2773         next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2774         my $i = $opachiddenitems ? C4::Items::GetItem($itemnumber) : undef;
2775         push @items, { itemnumber => $itemnumber, item => $i };
2776     }
2777     my @hiddenitems =
2778       $opachiddenitems
2779       ? C4::Items::GetHiddenItemnumbers( map { $_->{item} } @items )
2780       : ();
2781     # Convert to a hash for quick searching
2782     my %hiddenitems = map { $_ => 1 } @hiddenitems;
2783     foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2784         next if $hiddenitems{$itemnumber};
2785         my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2786         push @item_fields, $item_marc->field($itemtag);
2787     }
2788     $marc->append_fields(@item_fields);
2789 }
2790
2791 =head1 INTERNAL FUNCTIONS
2792
2793 =head2 _koha_marc_update_bib_ids
2794
2795
2796   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2797
2798 Internal function to add or update biblionumber and biblioitemnumber to
2799 the MARC XML.
2800
2801 =cut
2802
2803 sub _koha_marc_update_bib_ids {
2804     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2805
2806     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
2807     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2808     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
2809     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2810
2811     if ( $biblio_tag < 10 ) {
2812         C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2813     } else {
2814         C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2815     }
2816     if ( $biblioitem_tag < 10 ) {
2817         C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2818     } else {
2819         C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2820     }
2821 }
2822
2823 =head2 _koha_marc_update_biblioitem_cn_sort
2824
2825   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2826
2827 Given a MARC bib record and the biblioitem hash, update the
2828 subfield that contains a copy of the value of biblioitems.cn_sort.
2829
2830 =cut
2831
2832 sub _koha_marc_update_biblioitem_cn_sort {
2833     my $marc          = shift;
2834     my $biblioitem    = shift;
2835     my $frameworkcode = shift;
2836
2837     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
2838     return unless $biblioitem_tag;
2839
2840     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2841
2842     if ( my $field = $marc->field($biblioitem_tag) ) {
2843         $field->delete_subfield( code => $biblioitem_subfield );
2844         if ( $cn_sort ne '' ) {
2845             $field->add_subfields( $biblioitem_subfield => $cn_sort );
2846         }
2847     } else {
2848
2849         # if we get here, no biblioitem tag is present in the MARC record, so
2850         # we'll create it if $cn_sort is not empty -- this would be
2851         # an odd combination of events, however
2852         if ($cn_sort) {
2853             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2854         }
2855     }
2856 }
2857
2858 =head2 _koha_add_biblio
2859
2860   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2861
2862 Internal function to add a biblio ($biblio is a hash with the values)
2863
2864 =cut
2865
2866 sub _koha_add_biblio {
2867     my ( $dbh, $biblio, $frameworkcode ) = @_;
2868
2869     my $error;
2870
2871     # set the series flag
2872     unless (defined $biblio->{'serial'}){
2873         $biblio->{'serial'} = 0;
2874         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
2875     }
2876
2877     my $query = "INSERT INTO biblio
2878         SET frameworkcode = ?,
2879             author = ?,
2880             title = ?,
2881             unititle =?,
2882             notes = ?,
2883             serial = ?,
2884             seriestitle = ?,
2885             copyrightdate = ?,
2886             datecreated=NOW(),
2887             abstract = ?
2888         ";
2889     my $sth = $dbh->prepare($query);
2890     $sth->execute(
2891         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
2892         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
2893     );
2894
2895     my $biblionumber = $dbh->{'mysql_insertid'};
2896     if ( $dbh->errstr ) {
2897         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
2898         warn $error;
2899     }
2900
2901     $sth->finish();
2902
2903     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2904     return ( $biblionumber, $error );
2905 }
2906
2907 =head2 _koha_modify_biblio
2908
2909   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2910
2911 Internal function for updating the biblio table
2912
2913 =cut
2914
2915 sub _koha_modify_biblio {
2916     my ( $dbh, $biblio, $frameworkcode ) = @_;
2917     my $error;
2918
2919     my $query = "
2920         UPDATE biblio
2921         SET    frameworkcode = ?,
2922                author = ?,
2923                title = ?,
2924                unititle = ?,
2925                notes = ?,
2926                serial = ?,
2927                seriestitle = ?,
2928                copyrightdate = ?,
2929                abstract = ?
2930         WHERE  biblionumber = ?
2931         "
2932       ;
2933     my $sth = $dbh->prepare($query);
2934
2935     $sth->execute(
2936         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
2937         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
2938     ) if $biblio->{'biblionumber'};
2939
2940     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2941         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2942         warn $error;
2943     }
2944     return ( $biblio->{'biblionumber'}, $error );
2945 }
2946
2947 =head2 _koha_modify_biblioitem_nonmarc
2948
2949   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2950
2951 =cut
2952
2953 sub _koha_modify_biblioitem_nonmarc {
2954     my ( $dbh, $biblioitem ) = @_;
2955     my $error;
2956
2957     # re-calculate the cn_sort, it may have changed
2958     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2959
2960     my $query = "UPDATE biblioitems
2961     SET biblionumber    = ?,
2962         volume          = ?,
2963         number          = ?,
2964         itemtype        = ?,
2965         isbn            = ?,
2966         issn            = ?,
2967         publicationyear = ?,
2968         publishercode   = ?,
2969         volumedate      = ?,
2970         volumedesc      = ?,
2971         collectiontitle = ?,
2972         collectionissn  = ?,
2973         collectionvolume= ?,
2974         editionstatement= ?,
2975         editionresponsibility = ?,
2976         illus           = ?,
2977         pages           = ?,
2978         notes           = ?,
2979         size            = ?,
2980         place           = ?,
2981         lccn            = ?,
2982         url             = ?,
2983         cn_source       = ?,
2984         cn_class        = ?,
2985         cn_item         = ?,
2986         cn_suffix       = ?,
2987         cn_sort         = ?,
2988         totalissues     = ?,
2989         ean             = ?,
2990         agerestriction  = ?
2991         where biblioitemnumber = ?
2992         ";
2993     my $sth = $dbh->prepare($query);
2994     $sth->execute(
2995         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
2996         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
2997         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
2998         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2999         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3000         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3001         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3002         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
3003     );
3004     if ( $dbh->errstr ) {
3005         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3006         warn $error;
3007     }
3008     return ( $biblioitem->{'biblioitemnumber'}, $error );
3009 }
3010
3011 =head2 _koha_add_biblioitem
3012
3013   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3014
3015 Internal function to add a biblioitem
3016
3017 =cut
3018
3019 sub _koha_add_biblioitem {
3020     my ( $dbh, $biblioitem ) = @_;
3021     my $error;
3022
3023     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3024     my $query = "INSERT INTO biblioitems SET
3025         biblionumber    = ?,
3026         volume          = ?,
3027         number          = ?,
3028         itemtype        = ?,
3029         isbn            = ?,
3030         issn            = ?,
3031         publicationyear = ?,
3032         publishercode   = ?,
3033         volumedate      = ?,
3034         volumedesc      = ?,
3035         collectiontitle = ?,
3036         collectionissn  = ?,
3037         collectionvolume= ?,
3038         editionstatement= ?,
3039         editionresponsibility = ?,
3040         illus           = ?,
3041         pages           = ?,
3042         notes           = ?,
3043         size            = ?,
3044         place           = ?,
3045         lccn            = ?,
3046         url             = ?,
3047         cn_source       = ?,
3048         cn_class        = ?,
3049         cn_item         = ?,
3050         cn_suffix       = ?,
3051         cn_sort         = ?,
3052         totalissues     = ?,
3053         ean             = ?,
3054         agerestriction  = ?
3055         ";
3056     my $sth = $dbh->prepare($query);
3057     $sth->execute(
3058         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3059         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3060         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3061         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3062         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3063         $biblioitem->{'lccn'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3064         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3065         $biblioitem->{'totalissues'},      $biblioitem->{'ean'},              $biblioitem->{'agerestriction'}
3066     );
3067     my $bibitemnum = $dbh->{'mysql_insertid'};
3068
3069     if ( $dbh->errstr ) {
3070         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3071         warn $error;
3072     }
3073     $sth->finish();
3074     return ( $bibitemnum, $error );
3075 }
3076
3077 =head2 _koha_delete_biblio
3078
3079   $error = _koha_delete_biblio($dbh,$biblionumber);
3080
3081 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3082
3083 C<$dbh> - the database handle
3084
3085 C<$biblionumber> - the biblionumber of the biblio to be deleted
3086
3087 =cut
3088
3089 # FIXME: add error handling
3090
3091 sub _koha_delete_biblio {
3092     my ( $dbh, $biblionumber ) = @_;
3093
3094     # get all the data for this biblio
3095     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3096     $sth->execute($biblionumber);
3097
3098     # FIXME There is a transaction in _koha_delete_biblio_metadata
3099     # But actually all the following should be done inside a single transaction
3100     if ( my $data = $sth->fetchrow_hashref ) {
3101
3102         # save the record in deletedbiblio
3103         # find the fields to save
3104         my $query = "INSERT INTO deletedbiblio SET ";
3105         my @bind  = ();
3106         foreach my $temp ( keys %$data ) {
3107             $query .= "$temp = ?,";
3108             push( @bind, $data->{$temp} );
3109         }
3110
3111         # replace the last , by ",?)"
3112         $query =~ s/\,$//;
3113         my $bkup_sth = $dbh->prepare($query);
3114         $bkup_sth->execute(@bind);
3115         $bkup_sth->finish;
3116
3117         _koha_delete_biblio_metadata( $biblionumber );
3118
3119         # delete the biblio
3120         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3121         $sth2->execute($biblionumber);
3122         # update the timestamp (Bugzilla 7146)
3123         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3124         $sth2->execute($biblionumber);
3125         $sth2->finish;
3126     }
3127     $sth->finish;
3128     return;
3129 }
3130
3131 =head2 _koha_delete_biblioitems
3132
3133   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3134
3135 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3136
3137 C<$dbh> - the database handle
3138 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3139
3140 =cut
3141
3142 # FIXME: add error handling
3143
3144 sub _koha_delete_biblioitems {
3145     my ( $dbh, $biblioitemnumber ) = @_;
3146
3147     # get all the data for this biblioitem
3148     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3149     $sth->execute($biblioitemnumber);
3150
3151     if ( my $data = $sth->fetchrow_hashref ) {
3152
3153         # save the record in deletedbiblioitems
3154         # find the fields to save
3155         my $query = "INSERT INTO deletedbiblioitems SET ";
3156         my @bind  = ();
3157         foreach my $temp ( keys %$data ) {
3158             $query .= "$temp = ?,";
3159             push( @bind, $data->{$temp} );
3160         }
3161
3162         # replace the last , by ",?)"
3163         $query =~ s/\,$//;
3164         my $bkup_sth = $dbh->prepare($query);
3165         $bkup_sth->execute(@bind);
3166         $bkup_sth->finish;
3167
3168         # delete the biblioitem
3169         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3170         $sth2->execute($biblioitemnumber);
3171         # update the timestamp (Bugzilla 7146)
3172         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3173         $sth2->execute($biblioitemnumber);
3174         $sth2->finish;
3175     }
3176     $sth->finish;
3177     return;
3178 }
3179
3180 =head2 _koha_delete_biblio_metadata
3181
3182   $error = _koha_delete_biblio_metadata($biblionumber);
3183
3184 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3185
3186 =cut
3187
3188 sub _koha_delete_biblio_metadata {
3189     my ($biblionumber) = @_;
3190
3191     my $dbh    = C4::Context->dbh;
3192     my $schema = Koha::Database->new->schema;
3193     $schema->txn_do(
3194         sub {
3195             $dbh->do( q|
3196                 INSERT INTO deletedbiblio_metadata (biblionumber, format, marcflavour, metadata)
3197                 SELECT biblionumber, format, marcflavour, metadata FROM biblio_metadata WHERE biblionumber=?
3198             |,  undef, $biblionumber );
3199             $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
3200                 undef, $biblionumber );
3201         }
3202     );
3203 }
3204
3205 =head1 UNEXPORTED FUNCTIONS
3206
3207 =head2 ModBiblioMarc
3208
3209   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3210
3211 Add MARC XML data for a biblio to koha
3212
3213 Function exported, but should NOT be used, unless you really know what you're doing
3214
3215 =cut
3216
3217 sub ModBiblioMarc {
3218     # pass the MARC::Record to this function, and it will create the records in
3219     # the marcxml field
3220     my ( $record, $biblionumber, $frameworkcode ) = @_;
3221     if ( !$record ) {
3222         carp 'ModBiblioMarc passed an undefined record';
3223         return;
3224     }
3225
3226     # Clone record as it gets modified
3227     $record = $record->clone();
3228     my $dbh    = C4::Context->dbh;
3229     my @fields = $record->fields();
3230     if ( !$frameworkcode ) {
3231         $frameworkcode = "";
3232     }
3233     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3234     $sth->execute( $frameworkcode, $biblionumber );
3235     $sth->finish;
3236     my $encoding = C4::Context->preference("marcflavour");
3237
3238     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3239     if ( $encoding eq "UNIMARC" ) {
3240         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3241         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3242         my $string = $record->subfield( 100, "a" );
3243         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3244             my $f100 = $record->field(100);
3245             $record->delete_field($f100);
3246         } else {
3247             $string = POSIX::strftime( "%Y%m%d", localtime );
3248             $string =~ s/\-//g;
3249             $string = sprintf( "%-*s", 35, $string );
3250             substr ( $string, 22, 3, $defaultlanguage);
3251         }
3252         substr( $string, 25, 3, "y50" );
3253         unless ( $record->subfield( 100, "a" ) ) {
3254             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3255         }
3256     }
3257
3258     #enhancement 5374: update transaction date (005) for marc21/unimarc
3259     if($encoding =~ /MARC21|UNIMARC/) {
3260       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3261         # YY MM DD HH MM SS (update year and month)
3262       my $f005= $record->field('005');
3263       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3264     }
3265
3266     my $metadata = {
3267         biblionumber => $biblionumber,
3268         format       => 'marcxml',
3269         marcflavour  => C4::Context->preference('marcflavour'),
3270     };
3271     $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
3272
3273     # FIXME To replace with ->find_or_create?
3274     if ( my $m_rs = Koha::Biblio::Metadatas->find($metadata) ) {
3275         $m_rs->metadata( $record->as_xml_record($encoding) );
3276         $m_rs->store;
3277     } else {
3278         my $m_rs = Koha::Biblio::Metadata->new($metadata);
3279         $m_rs->metadata( $record->as_xml_record($encoding) );
3280         $m_rs->store;
3281     }
3282     ModZebra( $biblionumber, "specialUpdate", "biblioserver", $record );
3283     return $biblionumber;
3284 }
3285
3286 =head2 CountBiblioInOrders
3287
3288     $count = &CountBiblioInOrders( $biblionumber);
3289
3290 This function return count of biblios in orders with $biblionumber
3291
3292 =cut
3293
3294 sub CountBiblioInOrders {
3295  my ($biblionumber) = @_;
3296     my $dbh            = C4::Context->dbh;
3297     my $query          = "SELECT count(*)
3298           FROM  aqorders
3299           WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3300     my $sth = $dbh->prepare($query);
3301     $sth->execute($biblionumber);
3302     my $count = $sth->fetchrow;
3303     return ($count);
3304 }
3305
3306 =head2 prepare_host_field
3307
3308 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3309 Generate the host item entry for an analytic child entry
3310
3311 =cut
3312
3313 sub prepare_host_field {
3314     my ( $hostbiblio, $marcflavour ) = @_;
3315     $marcflavour ||= C4::Context->preference('marcflavour');
3316     my $host = GetMarcBiblio({ biblionumber => $hostbiblio });
3317     # unfortunately as_string does not 'do the right thing'
3318     # if field returns undef
3319     my %sfd;
3320     my $field;
3321     my $host_field;
3322     if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3323         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3324             my $s = $field->as_string('ab');
3325             if ($s) {
3326                 $sfd{a} = $s;
3327             }
3328         }
3329         if ( $field = $host->field('245') ) {
3330             my $s = $field->as_string('a');
3331             if ($s) {
3332                 $sfd{t} = $s;
3333             }
3334         }
3335         if ( $field = $host->field('260') ) {
3336             my $s = $field->as_string('abc');
3337             if ($s) {
3338                 $sfd{d} = $s;
3339             }
3340         }
3341         if ( $field = $host->field('240') ) {
3342             my $s = $field->as_string();
3343             if ($s) {
3344                 $sfd{b} = $s;
3345             }
3346         }
3347         if ( $field = $host->field('022') ) {
3348             my $s = $field->as_string('a');
3349             if ($s) {
3350                 $sfd{x} = $s;
3351             }
3352         }
3353         if ( $field = $host->field('020') ) {
3354             my $s = $field->as_string('a');
3355             if ($s) {
3356                 $sfd{z} = $s;
3357             }
3358         }
3359         if ( $field = $host->field('001') ) {
3360             $sfd{w} = $field->data(),;
3361         }
3362         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3363         return $host_field;
3364     }
3365     elsif ( $marcflavour eq 'UNIMARC' ) {
3366         #author
3367         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3368             my $s = $field->as_string('ab');
3369             if ($s) {
3370                 $sfd{a} = $s;
3371             }
3372         }
3373         #title
3374         if ( $field = $host->field('200') ) {
3375             my $s = $field->as_string('a');
3376             if ($s) {
3377                 $sfd{t} = $s;
3378             }
3379         }
3380         #place of publicaton
3381         if ( $field = $host->field('210') ) {
3382             my $s = $field->as_string('a');
3383             if ($s) {
3384                 $sfd{c} = $s;
3385             }
3386         }
3387         #date of publication
3388         if ( $field = $host->field('210') ) {
3389             my $s = $field->as_string('d');
3390             if ($s) {
3391                 $sfd{d} = $s;
3392             }
3393         }
3394         #edition statement
3395         if ( $field = $host->field('205') ) {
3396             my $s = $field->as_string();
3397             if ($s) {
3398                 $sfd{e} = $s;
3399             }
3400         }
3401         #URL
3402         if ( $field = $host->field('856') ) {
3403             my $s = $field->as_string('u');
3404             if ($s) {
3405                 $sfd{u} = $s;
3406             }
3407         }
3408         #ISSN
3409         if ( $field = $host->field('011') ) {
3410             my $s = $field->as_string('a');
3411             if ($s) {
3412                 $sfd{x} = $s;
3413             }
3414         }
3415         #ISBN
3416         if ( $field = $host->field('010') ) {
3417             my $s = $field->as_string('a');
3418             if ($s) {
3419                 $sfd{y} = $s;
3420             }
3421         }
3422         if ( $field = $host->field('001') ) {
3423             $sfd{0} = $field->data(),;
3424         }
3425         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3426         return $host_field;
3427     }
3428     return;
3429 }
3430
3431
3432 =head2 UpdateTotalIssues
3433
3434   UpdateTotalIssues($biblionumber, $increase, [$value])
3435
3436 Update the total issue count for a particular bib record.
3437
3438 =over 4
3439
3440 =item C<$biblionumber> is the biblionumber of the bib to update
3441
3442 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3443
3444 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3445
3446 =back
3447
3448 =cut
3449
3450 sub UpdateTotalIssues {
3451     my ($biblionumber, $increase, $value) = @_;
3452     my $totalissues;
3453
3454     my $record = GetMarcBiblio({ biblionumber => $biblionumber });
3455     unless ($record) {
3456         carp "UpdateTotalIssues could not get biblio record";
3457         return;
3458     }
3459     my $biblio = Koha::Biblios->find( $biblionumber );
3460     unless ($biblio) {
3461         carp "UpdateTotalIssues could not get datas of biblio";
3462         return;
3463     }
3464     my $biblioitem = $biblio->biblioitem;
3465     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $biblio->frameworkcode);
3466     unless ($totalissuestag) {
3467         return 1; # There is nothing to do
3468     }
3469
3470     if (defined $value) {
3471         $totalissues = $value;
3472     } else {
3473         $totalissues = $biblioitem->totalissues + $increase;
3474     }
3475
3476      my $field = $record->field($totalissuestag);
3477      if (defined $field) {
3478          $field->update( $totalissuessubfield => $totalissues );
3479      } else {
3480          $field = MARC::Field->new($totalissuestag, '0', '0',
3481                  $totalissuessubfield => $totalissues);
3482          $record->insert_grouped_field($field);
3483      }
3484
3485      return ModBiblio($record, $biblionumber, $biblio->frameworkcode);
3486 }
3487
3488 =head2 RemoveAllNsb
3489
3490     &RemoveAllNsb($record);
3491
3492 Removes all nsb/nse chars from a record
3493
3494 =cut
3495
3496 sub RemoveAllNsb {
3497     my $record = shift;
3498     if (!$record) {
3499         carp 'RemoveAllNsb called with undefined record';
3500         return;
3501     }
3502
3503     SetUTF8Flag($record);
3504
3505     foreach my $field ($record->fields()) {
3506         if ($field->is_control_field()) {
3507             $field->update(nsb_clean($field->data()));
3508         } else {
3509             my @subfields = $field->subfields();
3510             my @new_subfields;
3511             foreach my $subfield (@subfields) {
3512                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3513             }
3514             if (scalar(@new_subfields) > 0) {
3515                 my $new_field;
3516                 eval {
3517                     $new_field = MARC::Field->new(
3518                         $field->tag(),
3519                         $field->indicator(1),
3520                         $field->indicator(2),
3521                         @new_subfields
3522                     );
3523                 };
3524                 if ($@) {
3525                     warn "error in RemoveAllNsb : $@";
3526                 } else {
3527                     $field->replace_with($new_field);
3528                 }
3529             }
3530         }
3531     }
3532
3533     return $record;
3534 }
3535
3536 1;
3537
3538
3539 __END__
3540
3541 =head1 AUTHOR
3542
3543 Koha Development Team <http://koha-community.org/>
3544
3545 Paul POULAIN paul.poulain@free.fr
3546
3547 Joshua Ferraro jmf@liblime.com
3548
3549 =cut