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