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