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 GetClassSource );
  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" ) {
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         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "cn_source" ) {
1430             my $source = GetClassSource($value);
1431             return $source ? $source->{description} : q||;
1432         }
1433
1434         #---- "true" authorized value
1435         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1436     }
1437
1438     my $dbh = C4::Context->dbh;
1439     if ( $category ne "" ) {
1440         my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1441         $sth->execute( $category, $value );
1442         my $data = $sth->fetchrow_hashref;
1443         return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1444     } else {
1445         return $value;    # if nothing is found return the original value
1446     }
1447 }
1448
1449 =head2 GetMarcControlnumber
1450
1451   $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1452
1453 Get the control number / record Identifier from the MARC record and return it.
1454
1455 =cut
1456
1457 sub GetMarcControlnumber {
1458     my ( $record, $marcflavour ) = @_;
1459     if (!$record) {
1460         carp 'GetMarcControlnumber called on undefined record';
1461         return;
1462     }
1463     my $controlnumber = "";
1464     # Control number or Record identifier are the same field in MARC21 and UNIMARC
1465     # Keep $marcflavour for possible later use
1466     if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" ) {
1467         my $controlnumberField = $record->field('001');
1468         if ($controlnumberField) {
1469             $controlnumber = $controlnumberField->data();
1470         }
1471     }
1472     return $controlnumber;
1473 }
1474
1475 =head2 GetMarcISBN
1476
1477   $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1478
1479 Get all ISBNs from the MARC record and returns them in an array.
1480 ISBNs stored in different fields depending on MARC flavour
1481
1482 =cut
1483
1484 sub GetMarcISBN {
1485     my ( $record, $marcflavour ) = @_;
1486     if (!$record) {
1487         carp 'GetMarcISBN called on undefined record';
1488         return;
1489     }
1490     my $scope;
1491     if ( $marcflavour eq "UNIMARC" ) {
1492         $scope = '010';
1493     } else {    # assume marc21 if not unimarc
1494         $scope = '020';
1495     }
1496
1497     my @marcisbns;
1498     foreach my $field ( $record->field($scope) ) {
1499         my $isbn = $field->subfield( 'a' );
1500         if ( $isbn && $isbn ne "" ) {
1501             push @marcisbns, $isbn;
1502         }
1503     }
1504
1505     return \@marcisbns;
1506 }    # end GetMarcISBN
1507
1508
1509 =head2 GetMarcISSN
1510
1511   $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1512
1513 Get all valid ISSNs from the MARC record and returns them in an array.
1514 ISSNs are stored in different fields depending on MARC flavour
1515
1516 =cut
1517
1518 sub GetMarcISSN {
1519     my ( $record, $marcflavour ) = @_;
1520     if (!$record) {
1521         carp 'GetMarcISSN called on undefined record';
1522         return;
1523     }
1524     my $scope;
1525     if ( $marcflavour eq "UNIMARC" ) {
1526         $scope = '011';
1527     }
1528     else {    # assume MARC21
1529         $scope = '022';
1530     }
1531     my @marcissns;
1532     foreach my $field ( $record->field($scope) ) {
1533         push @marcissns, $field->subfield( 'a' )
1534             if ( $field->subfield( 'a' ) ne "" );
1535     }
1536     return \@marcissns;
1537 }    # end GetMarcISSN
1538
1539 =head2 GetMarcSubjects
1540
1541   $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1542
1543 Get all subjects from the MARC record and returns them in an array.
1544 The subjects are stored in different fields depending on MARC flavour
1545
1546 =cut
1547
1548 sub GetMarcSubjects {
1549     my ( $record, $marcflavour ) = @_;
1550     if (!$record) {
1551         carp 'GetMarcSubjects called on undefined record';
1552         return;
1553     }
1554     my ( $mintag, $maxtag, $fields_filter );
1555     if ( $marcflavour eq "UNIMARC" ) {
1556         $mintag = "600";
1557         $maxtag = "611";
1558         $fields_filter = '6..';
1559     } else { # marc21
1560         $mintag = "600";
1561         $maxtag = "699";
1562         $fields_filter = '6..';
1563     }
1564
1565     my @marcsubjects;
1566
1567     my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1568     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1569
1570     foreach my $field ( $record->field($fields_filter) ) {
1571         next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1572         my @subfields_loop;
1573         my @subfields = $field->subfields();
1574         my @link_loop;
1575
1576         # if there is an authority link, build the links with an= subfield9
1577         my $subfield9 = $field->subfield('9');
1578         my $authoritylink;
1579         if ($subfield9) {
1580             my $linkvalue = $subfield9;
1581             $linkvalue =~ s/(\(|\))//g;
1582             @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1583             $authoritylink = $linkvalue
1584         }
1585
1586         # other subfields
1587         for my $subject_subfield (@subfields) {
1588             next if ( $subject_subfield->[0] eq '9' );
1589
1590             # don't load unimarc subfields 3,4,5
1591             next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1592             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1593             next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1594
1595             my $code      = $subject_subfield->[0];
1596             my $value     = $subject_subfield->[1];
1597             my $linkvalue = $value;
1598             $linkvalue =~ s/(\(|\))//g;
1599             # if no authority link, build a search query
1600             unless ($subfield9) {
1601                 push @link_loop, {
1602                     limit    => $subject_limit,
1603                     'link'   => $linkvalue,
1604                     operator => (scalar @link_loop) ? ' and ' : undef
1605                 };
1606             }
1607             my @this_link_loop = @link_loop;
1608             # do not display $0
1609             unless ( $code eq '0' ) {
1610                 push @subfields_loop, {
1611                     code      => $code,
1612                     value     => $value,
1613                     link_loop => \@this_link_loop,
1614                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1615                 };
1616             }
1617         }
1618
1619         push @marcsubjects, {
1620             MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1621             authoritylink => $authoritylink,
1622         } if $authoritylink || @subfields_loop;
1623
1624     }
1625     return \@marcsubjects;
1626 }    #end getMARCsubjects
1627
1628 =head2 GetMarcAuthors
1629
1630   authors = GetMarcAuthors($record,$marcflavour);
1631
1632 Get all authors from the MARC record and returns them in an array.
1633 The authors are stored in different fields depending on MARC flavour
1634
1635 =cut
1636
1637 sub GetMarcAuthors {
1638     my ( $record, $marcflavour ) = @_;
1639     if (!$record) {
1640         carp 'GetMarcAuthors called on undefined record';
1641         return;
1642     }
1643     my ( $mintag, $maxtag, $fields_filter );
1644
1645     # tagslib useful only for UNIMARC author responsibilities
1646     my $tagslib;
1647     if ( $marcflavour eq "UNIMARC" ) {
1648         # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1649         $tagslib = GetMarcStructure( 1, '', { unsafe => 1 });
1650         $mintag = "700";
1651         $maxtag = "712";
1652         $fields_filter = '7..';
1653     } else { # marc21
1654         $mintag = "700";
1655         $maxtag = "720";
1656         $fields_filter = '7..';
1657     }
1658
1659     my @marcauthors;
1660     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1661
1662     foreach my $field ( $record->field($fields_filter) ) {
1663         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1664         my @subfields_loop;
1665         my @link_loop;
1666         my @subfields  = $field->subfields();
1667         my $count_auth = 0;
1668
1669         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1670         my $subfield9 = $field->subfield('9');
1671         if ($subfield9) {
1672             my $linkvalue = $subfield9;
1673             $linkvalue =~ s/(\(|\))//g;
1674             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1675         }
1676
1677         # other subfields
1678         my $unimarc3;
1679         for my $authors_subfield (@subfields) {
1680             next if ( $authors_subfield->[0] eq '9' );
1681
1682             # unimarc3 contains the $3 of the author for UNIMARC.
1683             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1684             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1685
1686             # don't load unimarc subfields 3, 5
1687             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1688
1689             my $code = $authors_subfield->[0];
1690             my $value        = $authors_subfield->[1];
1691             my $linkvalue    = $value;
1692             $linkvalue =~ s/(\(|\))//g;
1693             # UNIMARC author responsibility
1694             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1695                 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1696                 $linkvalue = "($value)";
1697             }
1698             # if no authority link, build a search query
1699             unless ($subfield9) {
1700                 push @link_loop, {
1701                     limit    => 'au',
1702                     'link'   => $linkvalue,
1703                     operator => (scalar @link_loop) ? ' and ' : undef
1704                 };
1705             }
1706             my @this_link_loop = @link_loop;
1707             # do not display $0
1708             unless ( $code eq '0') {
1709                 push @subfields_loop, {
1710                     tag       => $field->tag(),
1711                     code      => $code,
1712                     value     => $value,
1713                     link_loop => \@this_link_loop,
1714                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1715                 };
1716             }
1717         }
1718         push @marcauthors, {
1719             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1720             authoritylink => $subfield9,
1721             unimarc3 => $unimarc3
1722         };
1723     }
1724     return \@marcauthors;
1725 }
1726
1727 =head2 GetMarcUrls
1728
1729   $marcurls = GetMarcUrls($record,$marcflavour);
1730
1731 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1732 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1733
1734 =cut
1735
1736 sub GetMarcUrls {
1737     my ( $record, $marcflavour ) = @_;
1738     if (!$record) {
1739         carp 'GetMarcUrls called on undefined record';
1740         return;
1741     }
1742
1743     my @marcurls;
1744     for my $field ( $record->field('856') ) {
1745         my @notes;
1746         for my $note ( $field->subfield('z') ) {
1747             push @notes, { note => $note };
1748         }
1749         my @urls = $field->subfield('u');
1750         foreach my $url (@urls) {
1751             $url =~ s/^\s+|\s+$//g; # trim
1752             my $marcurl;
1753             if ( $marcflavour eq 'MARC21' ) {
1754                 my $s3   = $field->subfield('3');
1755                 my $link = $field->subfield('y');
1756                 unless ( $url =~ /^\w+:/ ) {
1757                     if ( $field->indicator(1) eq '7' ) {
1758                         $url = $field->subfield('2') . "://" . $url;
1759                     } elsif ( $field->indicator(1) eq '1' ) {
1760                         $url = 'ftp://' . $url;
1761                     } else {
1762
1763                         #  properly, this should be if ind1=4,
1764                         #  however we will assume http protocol since we're building a link.
1765                         $url = 'http://' . $url;
1766                     }
1767                 }
1768
1769                 # TODO handle ind 2 (relationship)
1770                 $marcurl = {
1771                     MARCURL => $url,
1772                     notes   => \@notes,
1773                 };
1774                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1775                 $marcurl->{'part'} = $s3 if ($link);
1776                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1777             } else {
1778                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1779                 $marcurl->{'MARCURL'} = $url;
1780             }
1781             push @marcurls, $marcurl;
1782         }
1783     }
1784     return \@marcurls;
1785 }
1786
1787 =head2 GetMarcSeries
1788
1789   $marcseriesarray = GetMarcSeries($record,$marcflavour);
1790
1791 Get all series from the MARC record and returns them in an array.
1792 The series are stored in different fields depending on MARC flavour
1793
1794 =cut
1795
1796 sub GetMarcSeries {
1797     my ( $record, $marcflavour ) = @_;
1798     if (!$record) {
1799         carp 'GetMarcSeries called on undefined record';
1800         return;
1801     }
1802
1803     my ( $mintag, $maxtag, $fields_filter );
1804     if ( $marcflavour eq "UNIMARC" ) {
1805         $mintag = "225";
1806         $maxtag = "225";
1807         $fields_filter = '2..';
1808     } else {    # marc21
1809         $mintag = "440";
1810         $maxtag = "490";
1811         $fields_filter = '4..';
1812     }
1813
1814     my @marcseries;
1815     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1816
1817     foreach my $field ( $record->field($fields_filter) ) {
1818         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1819         my @subfields_loop;
1820         my @subfields = $field->subfields();
1821         my @link_loop;
1822
1823         for my $series_subfield (@subfields) {
1824
1825             # ignore $9, used for authority link
1826             next if ( $series_subfield->[0] eq '9' );
1827
1828             my $volume_number;
1829             my $code      = $series_subfield->[0];
1830             my $value     = $series_subfield->[1];
1831             my $linkvalue = $value;
1832             $linkvalue =~ s/(\(|\))//g;
1833
1834             # see if this is an instance of a volume
1835             if ( $code eq 'v' ) {
1836                 $volume_number = 1;
1837             }
1838
1839             push @link_loop, {
1840                 'link' => $linkvalue,
1841                 operator => (scalar @link_loop) ? ' and ' : undef
1842             };
1843
1844             if ($volume_number) {
1845                 push @subfields_loop, { volumenum => $value };
1846             } else {
1847                 push @subfields_loop, {
1848                     code      => $code,
1849                     value     => $value,
1850                     link_loop => \@link_loop,
1851                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
1852                     volumenum => $volume_number,
1853                 }
1854             }
1855         }
1856         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1857
1858     }
1859     return \@marcseries;
1860 }    #end getMARCseriess
1861
1862 =head2 UpsertMarcSubfield
1863
1864     my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
1865
1866 =cut
1867
1868 sub UpsertMarcSubfield {
1869     my ($record, $tag, $code, $content) = @_;
1870     my $f = $record->field($tag);
1871
1872     if ($f) {
1873         $f->update( $code => $content );
1874     }
1875     else {
1876         my $f = MARC::Field->new( $tag, '', '', $code => $content);
1877         $record->insert_fields_ordered( $f );
1878     }
1879 }
1880
1881 =head2 UpsertMarcControlField
1882
1883     my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
1884
1885 =cut
1886
1887 sub UpsertMarcControlField {
1888     my ($record, $tag, $content) = @_;
1889     die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
1890     my $f = $record->field($tag);
1891
1892     if ($f) {
1893         $f->update( $content );
1894     }
1895     else {
1896         my $f = MARC::Field->new($tag, $content);
1897         $record->insert_fields_ordered( $f );
1898     }
1899 }
1900
1901 =head2 GetFrameworkCode
1902
1903   $frameworkcode = GetFrameworkCode( $biblionumber )
1904
1905 =cut
1906
1907 sub GetFrameworkCode {
1908     my ($biblionumber) = @_;
1909     my $dbh            = C4::Context->dbh;
1910     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1911     $sth->execute($biblionumber);
1912     my ($frameworkcode) = $sth->fetchrow;
1913     return $frameworkcode;
1914 }
1915
1916 =head2 TransformKohaToMarc
1917
1918     $record = TransformKohaToMarc( $hash [, $params ]  )
1919
1920 This function builds a (partial) MARC::Record from a hash.
1921 Hash entries can be from biblio, biblioitems or items.
1922 The params hash includes the parameter no_split used in C4::Items.
1923
1924 This function is called in acquisition module, to create a basic catalogue
1925 entry from user entry.
1926
1927 =cut
1928
1929
1930 sub TransformKohaToMarc {
1931     my ( $hash, $params ) = @_;
1932     my $record = MARC::Record->new();
1933     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1934
1935     # In the next call we use the Default framework, since it is considered
1936     # authoritative for Koha to Marc mappings.
1937     my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # do not change framework
1938     my $tag_hr = {};
1939     while ( my ($kohafield, $value) = each %$hash ) {
1940         foreach my $fld ( @{ $mss->{$kohafield} } ) {
1941             my $tagfield    = $fld->{tagfield};
1942             my $tagsubfield = $fld->{tagsubfield};
1943             next if !$tagfield;
1944
1945             # BZ 21800: split value if field is repeatable.
1946             my @values = _check_split($params, $fld, $value)
1947                 ? split(/\s?\|\s?/, $value, -1)
1948                 : ( $value );
1949             foreach my $value ( @values ) {
1950                 next if $value eq '';
1951                 $tag_hr->{$tagfield} //= [];
1952                 push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
1953             }
1954         }
1955     }
1956     foreach my $tag (sort keys %$tag_hr) {
1957         my @sfl = @{$tag_hr->{$tag}};
1958         @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
1959         @sfl = map { @{$_}; } @sfl;
1960         # Special care for control fields: remove the subfield indication @
1961         # and do not insert indicators.
1962         my @ind = $tag < 10 ? () : ( " ", " " );
1963         @sfl = grep { $_ ne '@' } @sfl if $tag < 10;
1964         $record->insert_fields_ordered( MARC::Field->new($tag, @ind, @sfl) );
1965     }
1966     return $record;
1967 }
1968
1969 sub _check_split {
1970 # Checks if $value must be split; may consult passed framework
1971     my ($params, $fld, $value) = @_;
1972     return if index($value,'|') == -1; # nothing to worry about
1973     return if $params->{no_split};
1974
1975     # if we did not get a specific framework, check default in $mss
1976     return $fld->{repeatable} if !$params->{framework};
1977
1978     # here we need to check the specific framework
1979     my $mss = GetMarcSubfieldStructure($params->{framework}, { unsafe => 1 });
1980     foreach my $fld2 ( @{ $mss->{ $fld->{kohafield} } } ) {
1981         next if $fld2->{tagfield} ne $fld->{tagfield};
1982         next if $fld2->{tagsubfield} ne $fld->{tagsubfield};
1983         return 1 if $fld2->{repeatable};
1984     }
1985     return;
1986 }
1987
1988 =head2 PrepHostMarcField
1989
1990     $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
1991
1992 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
1993
1994 =cut
1995
1996 sub PrepHostMarcField {
1997     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
1998     $marcflavour ||="MARC21";
1999
2000     my $hostrecord = GetMarcBiblio({ biblionumber => $hostbiblionumber });
2001     my $item = Koha::Items->find($hostitemnumber);
2002
2003         my $hostmarcfield;
2004     if ( $marcflavour eq "MARC21" ) {
2005
2006         #main entry
2007         my $mainentry;
2008         if ($hostrecord->subfield('100','a')){
2009             $mainentry = $hostrecord->subfield('100','a');
2010         } elsif ($hostrecord->subfield('110','a')){
2011             $mainentry = $hostrecord->subfield('110','a');
2012         } else {
2013             $mainentry = $hostrecord->subfield('111','a');
2014         }
2015
2016         # qualification info
2017         my $qualinfo;
2018         if (my $field260 = $hostrecord->field('260')){
2019             $qualinfo =  $field260->as_string( 'abc' );
2020         }
2021
2022
2023         #other fields
2024         my $ed = $hostrecord->subfield('250','a');
2025         my $barcode = $item->barcode;
2026         my $title = $hostrecord->subfield('245','a');
2027
2028         # record control number, 001 with 003 and prefix
2029         my $recctrlno;
2030         if ($hostrecord->field('001')){
2031             $recctrlno = $hostrecord->field('001')->data();
2032             if ($hostrecord->field('003')){
2033                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2034             }
2035         }
2036
2037         # issn/isbn
2038         my $issn = $hostrecord->subfield('022','a');
2039         my $isbn = $hostrecord->subfield('020','a');
2040
2041
2042         $hostmarcfield = MARC::Field->new(
2043                 773, '0', '',
2044                 '0' => $hostbiblionumber,
2045                 '9' => $hostitemnumber,
2046                 'a' => $mainentry,
2047                 'b' => $ed,
2048                 'd' => $qualinfo,
2049                 'o' => $barcode,
2050                 't' => $title,
2051                 'w' => $recctrlno,
2052                 'x' => $issn,
2053                 'z' => $isbn
2054                 );
2055     } elsif ($marcflavour eq "UNIMARC") {
2056         $hostmarcfield = MARC::Field->new(
2057             461, '', '',
2058             '0' => $hostbiblionumber,
2059             't' => $hostrecord->subfield('200','a'),
2060             '9' => $hostitemnumber
2061         );
2062     };
2063
2064     return $hostmarcfield;
2065 }
2066
2067 =head2 TransformHtmlToXml
2068
2069   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2070                              $ind_tag, $auth_type )
2071
2072 $auth_type contains :
2073
2074 =over
2075
2076 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2077
2078 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2079
2080 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2081
2082 =back
2083
2084 =cut
2085
2086 sub TransformHtmlToXml {
2087     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2088     # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2089
2090     my ( $perm_loc_tag, $perm_loc_subfield ) = C4::Biblio::GetMarcFromKohaField( "items.permanent_location" );
2091
2092     my $xml = MARC::File::XML::header('UTF-8');
2093     $xml .= "<record>\n";
2094     $auth_type = C4::Context->preference('marcflavour') unless $auth_type; # FIXME auth_type must be removed
2095     MARC::File::XML->default_record_format($auth_type);
2096
2097     # in UNIMARC, field 100 contains the encoding
2098     # check that there is one, otherwise the
2099     # MARC::Record->new_from_xml will fail (and Koha will die)
2100     my $unimarc_and_100_exist = 0;
2101     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
2102     my $prevtag = -1;
2103     my $first   = 1;
2104     my $j       = -1;
2105     my $close_last_tag;
2106     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2107         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2108
2109             # if we have a 100 field and it's values are not correct, skip them.
2110             # if we don't have any valid 100 field, we will create a default one at the end
2111             my $enc = substr( @$values[$i], 26, 2 );
2112             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2113                 $unimarc_and_100_exist = 1;
2114             } else {
2115                 next;
2116             }
2117         }
2118         @$values[$i] =~ s/&/&amp;/g;
2119         @$values[$i] =~ s/</&lt;/g;
2120         @$values[$i] =~ s/>/&gt;/g;
2121         @$values[$i] =~ s/"/&quot;/g;
2122         @$values[$i] =~ s/'/&apos;/g;
2123
2124         my $skip = @$values[$i] eq q{};
2125         $skip = 0
2126           if $perm_loc_tag
2127           && $perm_loc_subfield
2128           && @$tags[$i] eq $perm_loc_tag
2129           && @$subfields[$i] eq $perm_loc_subfield;
2130
2131         if ( ( @$tags[$i] ne $prevtag ) ) {
2132             $close_last_tag = 0;
2133             $j++ unless ( @$tags[$i] eq "" );
2134             my $str = ( $indicator->[$j] // q{} ) . '  '; # extra space prevents substr outside of string warn
2135             my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2136             my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2137             if ( !$first ) {
2138                 $xml .= "</datafield>\n";
2139                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2140                     && ( !$skip ) ) {
2141                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2142                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2143                     $first = 0;
2144                     $close_last_tag = 1;
2145                 } else {
2146                     $first = 1;
2147                 }
2148             } else {
2149                 if ( !$skip ) {
2150
2151                     # leader
2152                     if ( @$tags[$i] eq "000" ) {
2153                         $xml .= "<leader>@$values[$i]</leader>\n";
2154                         $first = 1;
2155
2156                         # rest of the fixed fields
2157                     } elsif ( @$tags[$i] < 10 ) {
2158                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2159                         $first = 1;
2160                     } else {
2161                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2162                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2163                         $first = 0;
2164                         $close_last_tag = 1;
2165                     }
2166                 }
2167             }
2168         } else {    # @$tags[$i] eq $prevtag
2169             if ( !$skip ) {
2170                 if ($first) {
2171                     my $str = ( $indicator->[$j] // q{} ) . '  '; # extra space prevents substr outside of string warn
2172                     my $ind1 = _default_ind_to_space( substr( $str, 0, 1 ) );
2173                     my $ind2 = _default_ind_to_space( substr( $str, 1, 1 ) );
2174                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2175                     $first = 0;
2176                     $close_last_tag = 1;
2177                 }
2178                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2179             }
2180         }
2181         $prevtag = @$tags[$i];
2182     }
2183     $xml .= "</datafield>\n" if $close_last_tag;
2184     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2185
2186         #     warn "SETTING 100 for $auth_type";
2187         my $string = strftime( "%Y%m%d", localtime(time) );
2188
2189         # set 50 to position 26 is biblios, 13 if authorities
2190         my $pos = 26;
2191         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2192         $string = sprintf( "%-*s", 35, $string );
2193         substr( $string, $pos, 6, "50" );
2194         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2195         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2196         $xml .= "</datafield>\n";
2197     }
2198     $xml .= "</record>\n";
2199     $xml .= MARC::File::XML::footer();
2200     return $xml;
2201 }
2202
2203 =head2 _default_ind_to_space
2204
2205 Passed what should be an indicator returns a space
2206 if its undefined or zero length
2207
2208 =cut
2209
2210 sub _default_ind_to_space {
2211     my $s = shift;
2212     if ( !defined $s || $s eq q{} ) {
2213         return ' ';
2214     }
2215     return $s;
2216 }
2217
2218 =head2 TransformHtmlToMarc
2219
2220     L<$record> = TransformHtmlToMarc(L<$cgi>)
2221     L<$cgi> is the CGI object which contains the values for subfields
2222     {
2223         'tag_010_indicator1_531951' ,
2224         'tag_010_indicator2_531951' ,
2225         'tag_010_code_a_531951_145735' ,
2226         'tag_010_subfield_a_531951_145735' ,
2227         'tag_200_indicator1_873510' ,
2228         'tag_200_indicator2_873510' ,
2229         'tag_200_code_a_873510_673465' ,
2230         'tag_200_subfield_a_873510_673465' ,
2231         'tag_200_code_b_873510_704318' ,
2232         'tag_200_subfield_b_873510_704318' ,
2233         'tag_200_code_e_873510_280822' ,
2234         'tag_200_subfield_e_873510_280822' ,
2235         'tag_200_code_f_873510_110730' ,
2236         'tag_200_subfield_f_873510_110730' ,
2237     }
2238     L<$record> is the MARC::Record object.
2239
2240 =cut
2241
2242 sub TransformHtmlToMarc {
2243     my ($cgi, $isbiblio) = @_;
2244
2245     my @params = $cgi->multi_param();
2246
2247     # explicitly turn on the UTF-8 flag for all
2248     # 'tag_' parameters to avoid incorrect character
2249     # conversion later on
2250     my $cgi_params = $cgi->Vars;
2251     foreach my $param_name ( keys %$cgi_params ) {
2252         if ( $param_name =~ /^tag_/ ) {
2253             my $param_value = $cgi_params->{$param_name};
2254             unless ( Encode::is_utf8( $param_value ) ) {
2255                 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2256             }
2257         }
2258     }
2259
2260     # creating a new record
2261     my $record = MARC::Record->new();
2262     my @fields;
2263     my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2264     ($biblionumbertagfield, $biblionumbertagsubfield) =
2265         &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2266 #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!
2267     for (my $i = 0; $params[$i]; $i++ ) {    # browse all CGI params
2268         my $param    = $params[$i];
2269         my $newfield = 0;
2270
2271         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2272         if ( $param eq 'biblionumber' ) {
2273             if ( $biblionumbertagfield < 10 ) {
2274                 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2275             } else {
2276                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2277             }
2278             push @fields, $newfield if ($newfield);
2279         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2280             my $tag = $1;
2281
2282             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2283             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2284             $newfield = 0;
2285             my $j = $i + 2;
2286
2287             if ( $tag < 10 ) {                              # no code for theses fields
2288                                                             # in MARC editor, 000 contains the leader.
2289                 next if $tag == $biblionumbertagfield;
2290                 my $fval= $cgi->param($params[$j+1]);
2291                 if ( $tag eq '000' ) {
2292                     # Force a fake leader even if not provided to avoid crashing
2293                     # during decoding MARC record containing UTF-8 characters
2294                     $record->leader(
2295                         length( $fval ) == 24
2296                         ? $fval
2297                         : '     nam a22        4500'
2298                         )
2299                     ;
2300                     # between 001 and 009 (included)
2301                 } elsif ( $fval ne '' ) {
2302                     $newfield = MARC::Field->new( $tag, $fval, );
2303                 }
2304
2305                 # > 009, deal with subfields
2306             } else {
2307                 # browse subfields for this tag (reason for _code_ match)
2308                 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2309                     last unless defined $params[$j+1];
2310                     $j += 2 and next
2311                         if $tag == $biblionumbertagfield and
2312                            $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2313                     #if next param ne subfield, then it was probably empty
2314                     #try next param by incrementing j
2315                     if($params[$j+1]!~/_subfield_/) {$j++; next; }
2316                     my $fkey= $cgi->param($params[$j]);
2317                     my $fval= $cgi->param($params[$j+1]);
2318                     #check if subfield value not empty and field exists
2319                     if($fval ne '' && $newfield) {
2320                         $newfield->add_subfields( $fkey => $fval);
2321                     }
2322                     elsif($fval ne '') {
2323                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2324                     }
2325                     $j += 2;
2326                 } #end-of-while
2327                 $i= $j-1; #update i for outer loop accordingly
2328             }
2329             push @fields, $newfield if ($newfield);
2330         }
2331     }
2332
2333     @fields = sort { $a->tag() cmp $b->tag() } @fields;
2334     $record->append_fields(@fields);
2335     return $record;
2336 }
2337
2338 =head2 TransformMarcToKoha
2339
2340     $result = TransformMarcToKoha( $record, undef, $limit )
2341
2342 Extract data from a MARC bib record into a hashref representing
2343 Koha biblio, biblioitems, and items fields.
2344
2345 If passed an undefined record will log the error and return an empty
2346 hash_ref.
2347
2348 =cut
2349
2350 sub TransformMarcToKoha {
2351     my ( $record, $frameworkcode, $limit_table ) = @_;
2352     # FIXME  Parameter $frameworkcode is obsolete and will be removed
2353     $limit_table //= q{};
2354
2355     my $result = {};
2356     if (!defined $record) {
2357         carp('TransformMarcToKoha called with undefined record');
2358         return $result;
2359     }
2360
2361     my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2362     if( $limit_table eq 'items' ) {
2363         %tables = ( items => 1 );
2364     } elsif ( $limit_table eq 'no_items' ){
2365         %tables = ( biblio => 1, biblioitems => 1 );
2366     }
2367
2368     # The next call acknowledges Default as the authoritative framework
2369     # for Koha to MARC mappings.
2370     my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2371     foreach my $kohafield ( keys %{ $mss } ) {
2372         my ( $table, $column ) = split /[.]/, $kohafield, 2;
2373         next unless $tables{$table};
2374         my $val = TransformMarcToKohaOneField( $kohafield, $record );
2375         next if !defined $val;
2376         my $key = _disambiguate( $table, $column );
2377         $result->{$key} = $val;
2378     }
2379     return $result;
2380 }
2381
2382 =head2 _disambiguate
2383
2384   $newkey = _disambiguate($table, $field);
2385
2386 This is a temporary hack to distinguish between the
2387 following sets of columns when using TransformMarcToKoha.
2388
2389   items.cn_source & biblioitems.cn_source
2390   items.cn_sort & biblioitems.cn_sort
2391
2392 Columns that are currently NOT distinguished (FIXME
2393 due to lack of time to fully test) are:
2394
2395   biblio.notes and biblioitems.notes
2396   biblionumber
2397   timestamp
2398   biblioitemnumber
2399
2400 FIXME - this is necessary because prefixing each column
2401 name with the table name would require changing lots
2402 of code and templates, and exposing more of the DB
2403 structure than is good to the UI templates, particularly
2404 since biblio and bibloitems may well merge in a future
2405 version.  In the future, it would also be good to
2406 separate DB access and UI presentation field names
2407 more.
2408
2409 =cut
2410
2411 sub _disambiguate {
2412     my ( $table, $column ) = @_;
2413     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2414         return $table . '.' . $column;
2415     } else {
2416         return $column;
2417     }
2418
2419 }
2420
2421 =head2 TransformMarcToKohaOneField
2422
2423     $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2424
2425     Note: The authoritative Default framework is used implicitly.
2426
2427 =cut
2428
2429 sub TransformMarcToKohaOneField {
2430     my ( $kohafield, $marc ) = @_;
2431
2432     my ( @rv, $retval );
2433     my @mss = GetMarcSubfieldStructureFromKohaField($kohafield);
2434     foreach my $fldhash ( @mss ) {
2435         my $tag = $fldhash->{tagfield};
2436         my $sub = $fldhash->{tagsubfield};
2437         foreach my $fld ( $marc->field($tag) ) {
2438             if( $sub eq '@' || $fld->is_control_field ) {
2439                 push @rv, $fld->data if $fld->data;
2440             } else {
2441                 push @rv, grep { $_ } $fld->subfield($sub);
2442             }
2443         }
2444     }
2445     return unless @rv;
2446     $retval = join ' | ', uniq(@rv);
2447
2448     # Additional polishing for individual kohafields
2449     if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2450         $retval = _adjust_pubyear( $retval );
2451     }
2452
2453     return $retval;
2454 }
2455
2456 =head2 _adjust_pubyear
2457
2458     Helper routine for TransformMarcToKohaOneField
2459
2460 =cut
2461
2462 sub _adjust_pubyear {
2463     my $retval = shift;
2464     # modify return value to keep only the 1st year found
2465     if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2466         $retval = $1;
2467     } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2468         $retval = $1;
2469     } elsif( $retval =~ m/
2470              (?<year>\d)[-]?[.Xx?]{3}
2471             |(?<year>\d{2})[.Xx?]{2}
2472             |(?<year>\d{3})[.Xx?]
2473             |(?<year>\d)[-]{3}\?
2474             |(?<year>\d\d)[-]{2}\?
2475             |(?<year>\d{3})[-]\?
2476     /xms ) { # the form 198-? occurred in Dutch ISBD rules
2477         my $digits = $+{year};
2478         $retval = $digits * ( 10 ** ( 4 - length($digits) ));
2479     } else {
2480         $retval = undef;
2481     }
2482     return $retval;
2483 }
2484
2485 =head2 CountItemsIssued
2486
2487     my $count = CountItemsIssued( $biblionumber );
2488
2489 =cut
2490
2491 sub CountItemsIssued {
2492     my ($biblionumber) = @_;
2493     my $dbh            = C4::Context->dbh;
2494     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2495     $sth->execute($biblionumber);
2496     my $row = $sth->fetchrow_hashref();
2497     return $row->{'issuedCount'};
2498 }
2499
2500 =head2 ModZebra
2501
2502     ModZebra( $record_number, $op, $server );
2503
2504 $record_number is the authid or biblionumber we want to index
2505
2506 $op is the operation: specialUpdate or recordDelete
2507
2508 $server is authorityserver or biblioserver
2509
2510 =cut
2511
2512 sub ModZebra {
2513     my ( $record_number, $op, $server ) = @_;
2514     Koha::Logger->get->debug("ModZebra: updates requested for: $record_number $op $server");
2515     my $dbh = C4::Context->dbh;
2516
2517     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2518     # at the same time
2519     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2520     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2521     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2522     WHERE server = ?
2523         AND   biblio_auth_number = ?
2524         AND   operation = ?
2525         AND   done = 0";
2526     my $check_sth = $dbh->prepare_cached($check_sql);
2527     $check_sth->execute( $server, $record_number, $op );
2528     my ($count) = $check_sth->fetchrow_array;
2529     $check_sth->finish();
2530     if ( $count == 0 ) {
2531         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2532         $sth->execute( $record_number, $server, $op );
2533         $sth->finish;
2534     }
2535 }
2536
2537 =head2 EmbedItemsInMarcBiblio
2538
2539     EmbedItemsInMarcBiblio({
2540         marc_record  => $marc,
2541         biblionumber => $biblionumber,
2542         item_numbers => $itemnumbers,
2543         opac         => $opac });
2544
2545 Given a MARC::Record object containing a bib record,
2546 modify it to include the items attached to it as 9XX
2547 per the bib's MARC framework.
2548 if $itemnumbers is defined, only specified itemnumbers are embedded.
2549
2550 If $opac is true, then opac-relevant suppressions are included.
2551
2552 If opac filtering will be done, borcat should be passed to properly
2553 override if necessary.
2554
2555 =cut
2556
2557 sub EmbedItemsInMarcBiblio {
2558     my ($params) = @_;
2559     my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2560     $marc = $params->{marc_record};
2561     if ( !$marc ) {
2562         carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2563         return;
2564     }
2565     $biblionumber = $params->{biblionumber};
2566     $itemnumbers = $params->{item_numbers};
2567     $opac = $params->{opac};
2568     $borcat = $params->{borcat} // q{};
2569
2570     $itemnumbers = [] unless defined $itemnumbers;
2571
2572     my $frameworkcode = GetFrameworkCode($biblionumber);
2573     _strip_item_fields($marc, $frameworkcode);
2574
2575     # ... and embed the current items
2576     my $dbh = C4::Context->dbh;
2577     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2578     $sth->execute($biblionumber);
2579     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
2580
2581     my @item_fields; # Array holding the actual MARC data for items to be included.
2582     my @items;       # Array holding items which are both in the list (sitenumbers)
2583                      # and on this biblionumber
2584
2585     # Flag indicating if there is potential hiding.
2586     my $opachiddenitems = $opac
2587       && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2588
2589     while ( my ($itemnumber) = $sth->fetchrow_array ) {
2590         next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2591         my $item;
2592         if ( $opachiddenitems ) {
2593             $item = Koha::Items->find($itemnumber);
2594             $item = $item ? $item->unblessed : undef;
2595         }
2596         push @items, { itemnumber => $itemnumber, item => $item };
2597     }
2598     my @items2pass = map { $_->{item} } @items;
2599     my @hiddenitems =
2600       $opachiddenitems
2601       ? C4::Items::GetHiddenItemnumbers({
2602             items  => \@items2pass,
2603             borcat => $borcat })
2604       : ();
2605     # Convert to a hash for quick searching
2606     my %hiddenitems = map { $_ => 1 } @hiddenitems;
2607     foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2608         next if $hiddenitems{$itemnumber};
2609         my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2610         push @item_fields, $item_marc->field($itemtag);
2611     }
2612     $marc->append_fields(@item_fields);
2613 }
2614
2615 =head1 INTERNAL FUNCTIONS
2616
2617 =head2 _koha_marc_update_bib_ids
2618
2619
2620   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2621
2622 Internal function to add or update biblionumber and biblioitemnumber to
2623 the MARC XML.
2624
2625 =cut
2626
2627 sub _koha_marc_update_bib_ids {
2628     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2629
2630     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber" );
2631     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2632     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber" );
2633     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2634
2635     if ( $biblio_tag < 10 ) {
2636         C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2637     } else {
2638         C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2639     }
2640     if ( $biblioitem_tag < 10 ) {
2641         C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2642     } else {
2643         C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2644     }
2645 }
2646
2647 =head2 _koha_marc_update_biblioitem_cn_sort
2648
2649   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2650
2651 Given a MARC bib record and the biblioitem hash, update the
2652 subfield that contains a copy of the value of biblioitems.cn_sort.
2653
2654 =cut
2655
2656 sub _koha_marc_update_biblioitem_cn_sort {
2657     my $marc          = shift;
2658     my $biblioitem    = shift;
2659     my $frameworkcode = shift;
2660
2661     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort" );
2662     return unless $biblioitem_tag;
2663
2664     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2665
2666     if ( my $field = $marc->field($biblioitem_tag) ) {
2667         $field->delete_subfield( code => $biblioitem_subfield );
2668         if ( $cn_sort ne '' ) {
2669             $field->add_subfields( $biblioitem_subfield => $cn_sort );
2670         }
2671     } else {
2672
2673         # if we get here, no biblioitem tag is present in the MARC record, so
2674         # we'll create it if $cn_sort is not empty -- this would be
2675         # an odd combination of events, however
2676         if ($cn_sort) {
2677             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2678         }
2679     }
2680 }
2681
2682 =head2 _koha_modify_biblio
2683
2684   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2685
2686 Internal function for updating the biblio table
2687
2688 =cut
2689
2690 sub _koha_modify_biblio {
2691     my ( $dbh, $biblio, $frameworkcode ) = @_;
2692     my $error;
2693
2694     my $query = "
2695         UPDATE biblio
2696         SET    frameworkcode = ?,
2697                author = ?,
2698                title = ?,
2699                subtitle = ?,
2700                medium = ?,
2701                part_number = ?,
2702                part_name = ?,
2703                unititle = ?,
2704                notes = ?,
2705                serial = ?,
2706                seriestitle = ?,
2707                copyrightdate = ?,
2708                abstract = ?
2709         WHERE  biblionumber = ?
2710         "
2711       ;
2712     my $sth = $dbh->prepare($query);
2713
2714     $sth->execute(
2715         $frameworkcode,        $biblio->{'author'},      $biblio->{'title'},       $biblio->{'subtitle'},
2716         $biblio->{'medium'},   $biblio->{'part_number'}, $biblio->{'part_name'},   $biblio->{'unititle'},
2717         $biblio->{'notes'},    $biblio->{'serial'},      $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef,
2718         $biblio->{'abstract'}, $biblio->{'biblionumber'}
2719     ) if $biblio->{'biblionumber'};
2720
2721     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2722         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2723         warn $error;
2724     }
2725     return ( $biblio->{'biblionumber'}, $error );
2726 }
2727
2728 =head2 _koha_modify_biblioitem_nonmarc
2729
2730   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2731
2732 =cut
2733
2734 sub _koha_modify_biblioitem_nonmarc {
2735     my ( $dbh, $biblioitem ) = @_;
2736     my $error;
2737
2738     # re-calculate the cn_sort, it may have changed
2739     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2740
2741     my $query = "UPDATE biblioitems
2742     SET biblionumber    = ?,
2743         volume          = ?,
2744         number          = ?,
2745         itemtype        = ?,
2746         isbn            = ?,
2747         issn            = ?,
2748         publicationyear = ?,
2749         publishercode   = ?,
2750         volumedate      = ?,
2751         volumedesc      = ?,
2752         collectiontitle = ?,
2753         collectionissn  = ?,
2754         collectionvolume= ?,
2755         editionstatement= ?,
2756         editionresponsibility = ?,
2757         illus           = ?,
2758         pages           = ?,
2759         notes           = ?,
2760         size            = ?,
2761         place           = ?,
2762         lccn            = ?,
2763         url             = ?,
2764         cn_source       = ?,
2765         cn_class        = ?,
2766         cn_item         = ?,
2767         cn_suffix       = ?,
2768         cn_sort         = ?,
2769         totalissues     = ?,
2770         ean             = ?,
2771         agerestriction  = ?
2772         where biblioitemnumber = ?
2773         ";
2774     my $sth = $dbh->prepare($query);
2775     $sth->execute(
2776         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
2777         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
2778         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
2779         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2780         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
2781         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2782         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
2783         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
2784     );
2785     if ( $dbh->errstr ) {
2786         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2787         warn $error;
2788     }
2789     return ( $biblioitem->{'biblioitemnumber'}, $error );
2790 }
2791
2792 =head2 _koha_delete_biblio
2793
2794   $error = _koha_delete_biblio($dbh,$biblionumber);
2795
2796 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2797
2798 C<$dbh> - the database handle
2799
2800 C<$biblionumber> - the biblionumber of the biblio to be deleted
2801
2802 =cut
2803
2804 # FIXME: add error handling
2805
2806 sub _koha_delete_biblio {
2807     my ( $dbh, $biblionumber ) = @_;
2808
2809     # get all the data for this biblio
2810     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2811     $sth->execute($biblionumber);
2812
2813     # FIXME There is a transaction in _koha_delete_biblio_metadata
2814     # But actually all the following should be done inside a single transaction
2815     if ( my $data = $sth->fetchrow_hashref ) {
2816
2817         # save the record in deletedbiblio
2818         # find the fields to save
2819         my $query = "INSERT INTO deletedbiblio SET ";
2820         my @bind  = ();
2821         foreach my $temp ( keys %$data ) {
2822             $query .= "$temp = ?,";
2823             push( @bind, $data->{$temp} );
2824         }
2825
2826         # replace the last , by ",?)"
2827         $query =~ s/\,$//;
2828         my $bkup_sth = $dbh->prepare($query);
2829         $bkup_sth->execute(@bind);
2830         $bkup_sth->finish;
2831
2832         _koha_delete_biblio_metadata( $biblionumber );
2833
2834         # delete the biblio
2835         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2836         $sth2->execute($biblionumber);
2837         # update the timestamp (Bugzilla 7146)
2838         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
2839         $sth2->execute($biblionumber);
2840         $sth2->finish;
2841     }
2842     $sth->finish;
2843     return;
2844 }
2845
2846 =head2 _koha_delete_biblioitems
2847
2848   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2849
2850 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2851
2852 C<$dbh> - the database handle
2853 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2854
2855 =cut
2856
2857 # FIXME: add error handling
2858
2859 sub _koha_delete_biblioitems {
2860     my ( $dbh, $biblioitemnumber ) = @_;
2861
2862     # get all the data for this biblioitem
2863     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2864     $sth->execute($biblioitemnumber);
2865
2866     if ( my $data = $sth->fetchrow_hashref ) {
2867
2868         # save the record in deletedbiblioitems
2869         # find the fields to save
2870         my $query = "INSERT INTO deletedbiblioitems SET ";
2871         my @bind  = ();
2872         foreach my $temp ( keys %$data ) {
2873             $query .= "$temp = ?,";
2874             push( @bind, $data->{$temp} );
2875         }
2876
2877         # replace the last , by ",?)"
2878         $query =~ s/\,$//;
2879         my $bkup_sth = $dbh->prepare($query);
2880         $bkup_sth->execute(@bind);
2881         $bkup_sth->finish;
2882
2883         # delete the biblioitem
2884         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2885         $sth2->execute($biblioitemnumber);
2886         # update the timestamp (Bugzilla 7146)
2887         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
2888         $sth2->execute($biblioitemnumber);
2889         $sth2->finish;
2890     }
2891     $sth->finish;
2892     return;
2893 }
2894
2895 =head2 _koha_delete_biblio_metadata
2896
2897   $error = _koha_delete_biblio_metadata($biblionumber);
2898
2899 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
2900
2901 =cut
2902
2903 sub _koha_delete_biblio_metadata {
2904     my ($biblionumber) = @_;
2905
2906     my $dbh    = C4::Context->dbh;
2907     my $schema = Koha::Database->new->schema;
2908     $schema->txn_do(
2909         sub {
2910             $dbh->do( q|
2911                 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
2912                 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
2913             |,  undef, $biblionumber );
2914             $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
2915                 undef, $biblionumber );
2916         }
2917     );
2918 }
2919
2920 =head1 UNEXPORTED FUNCTIONS
2921
2922 =head2 ModBiblioMarc
2923
2924   &ModBiblioMarc($newrec,$biblionumber);
2925
2926 Add MARC XML data for a biblio to koha
2927
2928 Function exported, but should NOT be used, unless you really know what you're doing
2929
2930 =cut
2931
2932 sub ModBiblioMarc {
2933     # pass the MARC::Record to this function, and it will create the records in
2934     # the marcxml field
2935     my ( $record, $biblionumber ) = @_;
2936     if ( !$record ) {
2937         carp 'ModBiblioMarc passed an undefined record';
2938         return;
2939     }
2940
2941     # Clone record as it gets modified
2942     $record = $record->clone();
2943     my $dbh    = C4::Context->dbh;
2944     my @fields = $record->fields();
2945     my $encoding = C4::Context->preference("marcflavour");
2946
2947     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
2948     if ( $encoding eq "UNIMARC" ) {
2949         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
2950         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
2951         my $string = $record->subfield( 100, "a" );
2952         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
2953             my $f100 = $record->field(100);
2954             $record->delete_field($f100);
2955         } else {
2956             $string = POSIX::strftime( "%Y%m%d", localtime );
2957             $string =~ s/\-//g;
2958             $string = sprintf( "%-*s", 35, $string );
2959             substr ( $string, 22, 3, $defaultlanguage);
2960         }
2961         substr( $string, 25, 3, "y50" );
2962         unless ( $record->subfield( 100, "a" ) ) {
2963             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
2964         }
2965     }
2966
2967     #enhancement 5374: update transaction date (005) for marc21/unimarc
2968     if($encoding =~ /MARC21|UNIMARC/) {
2969       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
2970         # YY MM DD HH MM SS (update year and month)
2971       my $f005= $record->field('005');
2972       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
2973     }
2974
2975     my $metadata = {
2976         biblionumber => $biblionumber,
2977         format       => 'marcxml',
2978         schema       => C4::Context->preference('marcflavour'),
2979     };
2980     $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
2981
2982     my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
2983         Koha::Biblio::Metadata->new($metadata);
2984
2985     my $userenv = C4::Context->userenv;
2986     if ($userenv) {
2987         my $borrowernumber = $userenv->{number};
2988         my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
2989         unless ($m_rs->in_storage) {
2990             Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
2991             Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
2992         }
2993         Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
2994         Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
2995     }
2996
2997     $m_rs->metadata( $record->as_xml_record($encoding) );
2998     $m_rs->store;
2999
3000     my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
3001     $indexer->index_records( $biblionumber, "specialUpdate", "biblioserver" );
3002
3003     return $biblionumber;
3004 }
3005
3006 =head2 prepare_host_field
3007
3008 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3009 Generate the host item entry for an analytic child entry
3010
3011 =cut
3012
3013 sub prepare_host_field {
3014     my ( $hostbiblio, $marcflavour ) = @_;
3015     $marcflavour ||= C4::Context->preference('marcflavour');
3016     my $host = GetMarcBiblio({ biblionumber => $hostbiblio });
3017     # unfortunately as_string does not 'do the right thing'
3018     # if field returns undef
3019     my %sfd;
3020     my $field;
3021     my $host_field;
3022     if ( $marcflavour eq 'MARC21' ) {
3023         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3024             my $s = $field->as_string('ab');
3025             if ($s) {
3026                 $sfd{a} = $s;
3027             }
3028         }
3029         if ( $field = $host->field('245') ) {
3030             my $s = $field->as_string('a');
3031             if ($s) {
3032                 $sfd{t} = $s;
3033             }
3034         }
3035         if ( $field = $host->field('260') ) {
3036             my $s = $field->as_string('abc');
3037             if ($s) {
3038                 $sfd{d} = $s;
3039             }
3040         }
3041         if ( $field = $host->field('240') ) {
3042             my $s = $field->as_string();
3043             if ($s) {
3044                 $sfd{b} = $s;
3045             }
3046         }
3047         if ( $field = $host->field('022') ) {
3048             my $s = $field->as_string('a');
3049             if ($s) {
3050                 $sfd{x} = $s;
3051             }
3052         }
3053         if ( $field = $host->field('020') ) {
3054             my $s = $field->as_string('a');
3055             if ($s) {
3056                 $sfd{z} = $s;
3057             }
3058         }
3059         if ( $field = $host->field('001') ) {
3060             $sfd{w} = $field->data(),;
3061         }
3062         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3063         return $host_field;
3064     }
3065     elsif ( $marcflavour eq 'UNIMARC' ) {
3066         #author
3067         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3068             my $s = $field->as_string('ab');
3069             if ($s) {
3070                 $sfd{a} = $s;
3071             }
3072         }
3073         #title
3074         if ( $field = $host->field('200') ) {
3075             my $s = $field->as_string('a');
3076             if ($s) {
3077                 $sfd{t} = $s;
3078             }
3079         }
3080         #place of publicaton
3081         if ( $field = $host->field('210') ) {
3082             my $s = $field->as_string('a');
3083             if ($s) {
3084                 $sfd{c} = $s;
3085             }
3086         }
3087         #date of publication
3088         if ( $field = $host->field('210') ) {
3089             my $s = $field->as_string('d');
3090             if ($s) {
3091                 $sfd{d} = $s;
3092             }
3093         }
3094         #edition statement
3095         if ( $field = $host->field('205') ) {
3096             my $s = $field->as_string();
3097             if ($s) {
3098                 $sfd{e} = $s;
3099             }
3100         }
3101         #URL
3102         if ( $field = $host->field('856') ) {
3103             my $s = $field->as_string('u');
3104             if ($s) {
3105                 $sfd{u} = $s;
3106             }
3107         }
3108         #ISSN
3109         if ( $field = $host->field('011') ) {
3110             my $s = $field->as_string('a');
3111             if ($s) {
3112                 $sfd{x} = $s;
3113             }
3114         }
3115         #ISBN
3116         if ( $field = $host->field('010') ) {
3117             my $s = $field->as_string('a');
3118             if ($s) {
3119                 $sfd{y} = $s;
3120             }
3121         }
3122         if ( $field = $host->field('001') ) {
3123             $sfd{0} = $field->data(),;
3124         }
3125         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3126         return $host_field;
3127     }
3128     return;
3129 }
3130
3131
3132 =head2 UpdateTotalIssues
3133
3134   UpdateTotalIssues($biblionumber, $increase, [$value])
3135
3136 Update the total issue count for a particular bib record.
3137
3138 =over 4
3139
3140 =item C<$biblionumber> is the biblionumber of the bib to update
3141
3142 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3143
3144 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3145
3146 =back
3147
3148 =cut
3149
3150 sub UpdateTotalIssues {
3151     my ($biblionumber, $increase, $value) = @_;
3152     my $totalissues;
3153
3154     my $record = GetMarcBiblio({ biblionumber => $biblionumber });
3155     unless ($record) {
3156         carp "UpdateTotalIssues could not get biblio record";
3157         return;
3158     }
3159     my $biblio = Koha::Biblios->find( $biblionumber );
3160     unless ($biblio) {
3161         carp "UpdateTotalIssues could not get datas of biblio";
3162         return;
3163     }
3164     my $biblioitem = $biblio->biblioitem;
3165     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField( 'biblioitems.totalissues' );
3166     unless ($totalissuestag) {
3167         return 1; # There is nothing to do
3168     }
3169
3170     if (defined $value) {
3171         $totalissues = $value;
3172     } else {
3173         $totalissues = $biblioitem->totalissues + $increase;
3174     }
3175
3176      my $field = $record->field($totalissuestag);
3177      if (defined $field) {
3178          $field->update( $totalissuessubfield => $totalissues );
3179      } else {
3180          $field = MARC::Field->new($totalissuestag, '0', '0',
3181                  $totalissuessubfield => $totalissues);
3182          $record->insert_grouped_field($field);
3183      }
3184
3185      return ModBiblio($record, $biblionumber, $biblio->frameworkcode);
3186 }
3187
3188 =head2 RemoveAllNsb
3189
3190     &RemoveAllNsb($record);
3191
3192 Removes all nsb/nse chars from a record
3193
3194 =cut
3195
3196 sub RemoveAllNsb {
3197     my $record = shift;
3198     if (!$record) {
3199         carp 'RemoveAllNsb called with undefined record';
3200         return;
3201     }
3202
3203     SetUTF8Flag($record);
3204
3205     foreach my $field ($record->fields()) {
3206         if ($field->is_control_field()) {
3207             $field->update(nsb_clean($field->data()));
3208         } else {
3209             my @subfields = $field->subfields();
3210             my @new_subfields;
3211             foreach my $subfield (@subfields) {
3212                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3213             }
3214             if (scalar(@new_subfields) > 0) {
3215                 my $new_field;
3216                 eval {
3217                     $new_field = MARC::Field->new(
3218                         $field->tag(),
3219                         $field->indicator(1),
3220                         $field->indicator(2),
3221                         @new_subfields
3222                     );
3223                 };
3224                 if ($@) {
3225                     warn "error in RemoveAllNsb : $@";
3226                 } else {
3227                     $field->replace_with($new_field);
3228                 }
3229             }
3230         }
3231     }
3232
3233     return $record;
3234 }
3235
3236 1;
3237
3238
3239 =head2 _after_biblio_action_hooks
3240
3241 Helper method that takes care of calling all plugin hooks
3242
3243 =cut
3244
3245 sub _after_biblio_action_hooks {
3246     my ( $args ) = @_;
3247
3248     my $biblio_id = $args->{biblio_id};
3249     my $action    = $args->{action};
3250
3251     my $biblio = Koha::Biblios->find( $biblio_id );
3252     Koha::Plugins->call(
3253         'after_biblio_action',
3254         {
3255             action    => $action,
3256             biblio    => $biblio,
3257             biblio_id => $biblio_id,
3258         }
3259     );
3260 }
3261
3262 __END__
3263
3264 =head1 AUTHOR
3265
3266 Koha Development Team <http://koha-community.org/>
3267
3268 Paul POULAIN paul.poulain@free.fr
3269
3270 Joshua Ferraro jmf@liblime.com
3271
3272 =cut