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