C4/Biblio.pm

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