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