C4/Biblio.pm

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