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