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