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