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