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