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