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