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