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