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