C4/Biblio.pm

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