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