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