C4/Biblio.pm

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