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