C4/Biblio.pm

   1 package C4::Biblio;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 # Copyright 2010 BibLibre
   5 # Copyright 2011 Equinox Software, Inc.
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21
  22 use Modern::Perl;
  23
  24 use vars qw(@ISA @EXPORT_OK);
  25 BEGIN {
  26     require Exporter;
  27     @ISA = qw(Exporter);
  28
  29     @EXPORT_OK = qw(
  30         AddBiblio
  31         GetBiblioData
  32         GetMarcBiblio
  33         GetISBDView
  34         GetMarcControlnumber
  35         GetMarcISBN
  36         GetMarcISSN
  37         GetMarcSubjects
  38         GetMarcSeries
  39         GetMarcUrls
  40         GetUsedMarcStructure
  41         GetXmlBiblio
  42         GetMarcPrice
  43         MungeMarcPrice
  44         GetMarcQuantity
  45         GetAuthorisedValueDesc
  46         GetMarcStructure
  47         GetMarcSubfieldStructure
  48         IsMarcStructureInternal
  49         GetMarcFromKohaField
  50         GetMarcSubfieldStructureFromKohaField
  51         GetFrameworkCode
  52         TransformKohaToMarc
  53         PrepHostMarcField
  54         CountItemsIssued
  55         ModBiblio
  56         ModZebra
  57         EmbedItemsInMarcBiblio
  58         UpdateTotalIssues
  59         RemoveAllNsb
  60         DelBiblio
  61         BiblioAutoLink
  62         LinkBibHeadingsToAuthorities
  63         ApplyMarcOverlayRules
  64         TransformMarcToKoha
  65         TransformHtmlToMarc
  66         TransformHtmlToXml
  67         prepare_host_field
  68         TransformMarcToKohaOneField
  69     );
  70
  71     # Internal functions
  72     # those functions are exported but should not be used
  73     # they are useful in a few circumstances, so they are exported,
  74     # but don't use them unless you are a core developer ;-)
  75     push @EXPORT_OK, qw(
  76       ModBiblioMarc
  77     );
  78 }
  79
  80 use Carp qw( carp );
  81 use Try::Tiny qw( catch try );
  82
  83 use Encode;
  84 use List::MoreUtils qw( uniq );
  85 use MARC::Record;
  86 use MARC::File::USMARC;
  87 use MARC::File::XML;
  88 use POSIX qw( strftime );
  89 use Module::Load::Conditional qw( can_load );
  90
  91 use C4::Koha;
  92 use C4::Log qw( logaction );    # logaction
  93 use C4::Budgets;
  94 use C4::ClassSource qw( GetClassSort GetClassSource );
  95 use C4::Charset qw(
  96     nsb_clean
  97     SetMarcUnicodeFlag
  98     SetUTF8Flag
  99     StripNonXmlChars
 100 );
 101 use C4::Linker;
 102 use C4::OAI::Sets;
 103 use C4::Items qw( GetHiddenItemnumbers GetMarcItem );
 104
 105 use Koha::Logger;
 106 use Koha::Caches;
 107 use Koha::Authority::Types;
 108 use Koha::Acquisition::Currencies;
 109 use Koha::BackgroundJob::BatchUpdateBiblioHoldsQueue;
 110 use Koha::Biblio::Metadatas;
 111 use Koha::Holds;
 112 use Koha::ItemTypes;
 113 use Koha::MarcOverlayRules;
 114 use Koha::Plugins;
 115 use Koha::SearchEngine;
 116 use Koha::SearchEngine::Indexer;
 117 use Koha::Libraries;
 118 use Koha::Util::MARC;
 119
 120 =head1 NAME
 121
 122 C4::Biblio - cataloging management functions
 123
 124 =head1 DESCRIPTION
 125
 126 Biblio.pm contains functions for managing storage and editing of bibliographic data within Koha. Most of the functions in this module are used for cataloging records: adding, editing, or removing biblios, biblioitems, or items. Koha's stores bibliographic information in three places:
 127
 128 =over 4
 129
 130 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
 131
 132 =item 2. as raw MARC in the Zebra index and storage engine
 133
 134 =item 3. as MARC XML in biblio_metadata.metadata
 135
 136 =back
 137
 138 In the 3.0 version of Koha, the authoritative record-level information is in biblio_metadata.metadata
 139
 140 Because the data isn't completely normalized there's a chance for information to get out of sync. The design choice to go with a un-normalized schema was driven by performance and stability concerns. However, if this occur, it can be considered as a bug : The API is (or should be) complete & the only entry point for all biblio/items managements.
 141
 142 =over 4
 143
 144 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
 145
 146 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
 147
 148 =back
 149
 150 Because of this design choice, the process of managing storage and editing is a bit convoluted. Historically, Biblio.pm's grown to an unmanagable size and as a result we have several types of functions currently:
 151
 152 =over 4
 153
 154 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
 155
 156 =item 2. _koha_* - low-level internal functions for managing the koha tables
 157
 158 =item 3. Marc management function : as the MARC record is stored in biblio_metadata.metadata, some subs dedicated to it's management are in this package. They should be used only internally by Biblio.pm, the only official entry points being AddBiblio, AddItem, ModBiblio, ModItem.
 159
 160 =item 4. Zebra functions used to update the Zebra index
 161
 162 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
 163
 164 =back
 165
 166 The MARC record (in biblio_metadata.metadata) contains the complete marc record, including items. It also contains the biblionumber. That is the reason why it is not stored directly by AddBiblio, with all other fields . To save a biblio, we need to :
 167
 168 =over 4
 169
 170 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
 171
 172 =item 2. add the biblionumber and biblioitemnumber into the MARC records
 173
 174 =item 3. save the marc record
 175
 176 =back
 177
 178 =head1 EXPORTED FUNCTIONS
 179
 180 =head2 AddBiblio
 181
 182   ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
 183
 184 Exported function (core API) for adding a new biblio to koha.
 185
 186 The first argument is a C<MARC::Record> object containing the
 187 bib to add, while the second argument is the desired MARC
 188 framework code.
 189
 190 This function also accepts a third, optional argument: a hashref
 191 to additional options.  The only defined option is C<defer_marc_save>,
 192 which if present and mapped to a true value, causes C<AddBiblio>
 193 to omit the call to save the MARC in C<biblio_metadata.metadata>
 194 This option is provided B<only>
 195 for the use of scripts such as C<bulkmarcimport.pl> that may need
 196 to do some manipulation of the MARC record for item parsing before
 197 saving it and which cannot afford the performance hit of saving
 198 the MARC record twice.  Consequently, do not use that option
 199 unless you can guarantee that C<ModBiblioMarc> will be called.
 200
 201 =cut
 202
 203 sub AddBiblio {
 204     my $record          = shift;
 205     my $frameworkcode   = shift;
 206     my $options         = @_ ? shift : undef;
 207     my $defer_marc_save = 0;
 208     if (!$record) {
 209         carp('AddBiblio called with undefined record');
 210         return;
 211     }
 212     if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
 213         $defer_marc_save = 1;
 214     }
 215
 216     my $schema = Koha::Database->schema;
 217     my ( $biblionumber, $biblioitemnumber );
 218     try {
 219         $schema->txn_do(sub {
 220
 221             # transform the data into koha-table style data
 222             SetUTF8Flag($record);
 223             my $olddata = TransformMarcToKoha( $record, $frameworkcode );
 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, $frameworkcode );
 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, undef, $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 ( $record, $frameworkcode, $limit_table ) = @_;
2307     # FIXME  Parameter $frameworkcode is obsolete and will be removed
2308     $limit_table //= q{};
2309
2310     my $result = {};
2311     if (!defined $record) {
2312         carp('TransformMarcToKoha called with undefined record');
2313         return $result;
2314     }
2315
2316     my %tables = ( biblio => 1, biblioitems => 1, items => 1 );
2317     if( $limit_table eq 'items' ) {
2318         %tables = ( items => 1 );
2319     } elsif ( $limit_table eq 'no_items' ){
2320         %tables = ( biblio => 1, biblioitems => 1 );
2321     }
2322
2323     # The next call acknowledges Default as the authoritative framework
2324     # for Koha to MARC mappings.
2325     my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework
2326     foreach my $kohafield ( keys %{ $mss } ) {
2327         my ( $table, $column ) = split /[.]/, $kohafield, 2;
2328         next unless $tables{$table};
2329         my $val = TransformMarcToKohaOneField( $kohafield, $record );
2330         next if !defined $val;
2331         my $key = _disambiguate( $table, $column );
2332         $result->{$key} = $val;
2333     }
2334     return $result;
2335 }
2336
2337 =head2 _disambiguate
2338
2339   $newkey = _disambiguate($table, $field);
2340
2341 This is a temporary hack to distinguish between the
2342 following sets of columns when using TransformMarcToKoha.
2343
2344   items.cn_source & biblioitems.cn_source
2345   items.cn_sort & biblioitems.cn_sort
2346
2347 Columns that are currently NOT distinguished (FIXME
2348 due to lack of time to fully test) are:
2349
2350   biblio.notes and biblioitems.notes
2351   biblionumber
2352   timestamp
2353   biblioitemnumber
2354
2355 FIXME - this is necessary because prefixing each column
2356 name with the table name would require changing lots
2357 of code and templates, and exposing more of the DB
2358 structure than is good to the UI templates, particularly
2359 since biblio and bibloitems may well merge in a future
2360 version.  In the future, it would also be good to
2361 separate DB access and UI presentation field names
2362 more.
2363
2364 =cut
2365
2366 sub _disambiguate {
2367     my ( $table, $column ) = @_;
2368     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2369         return $table . '.' . $column;
2370     } else {
2371         return $column;
2372     }
2373
2374 }
2375
2376 =head2 TransformMarcToKohaOneField
2377
2378     $val = TransformMarcToKohaOneField( 'biblio.title', $marc );
2379
2380     Note: The authoritative Default framework is used implicitly.
2381
2382 =cut
2383
2384 sub TransformMarcToKohaOneField {
2385     my ( $kohafield, $marc ) = @_;
2386
2387     my ( @rv, $retval );
2388     my @mss = GetMarcSubfieldStructureFromKohaField($kohafield);
2389     foreach my $fldhash ( @mss ) {
2390         my $tag = $fldhash->{tagfield};
2391         my $sub = $fldhash->{tagsubfield};
2392         foreach my $fld ( $marc->field($tag) ) {
2393             if( $sub eq '@' || $fld->is_control_field ) {
2394                 push @rv, $fld->data if $fld->data;
2395             } else {
2396                 push @rv, grep { $_ } $fld->subfield($sub);
2397             }
2398         }
2399     }
2400     return unless @rv;
2401     $retval = join ' | ', uniq(@rv);
2402
2403     # Additional polishing for individual kohafields
2404     if( $kohafield =~ /copyrightdate|publicationyear/ ) {
2405         $retval = _adjust_pubyear( $retval );
2406     }
2407
2408     return $retval;
2409 }
2410
2411 =head2 _adjust_pubyear
2412
2413     Helper routine for TransformMarcToKohaOneField
2414
2415 =cut
2416
2417 sub _adjust_pubyear {
2418     my $retval = shift;
2419     # modify return value to keep only the 1st year found
2420     if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2421         $retval = $1;
2422     } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) {
2423         $retval = $1;
2424     } elsif( $retval =~ m/(?<year>\d{1,3})[.Xx?-]/ ) {
2425         # See also bug 24674: enough to look at one unknown year char like .Xx-?
2426         # At this point in code 1234? or 1234- already passed the earlier regex
2427         # Things like 2-, 1xx, 1??? are now converted to a four positions-year.
2428         $retval = $+{year} * ( 10 ** (4-length($+{year})) );
2429     } else {
2430         $retval = undef;
2431     }
2432     return $retval;
2433 }
2434
2435 =head2 CountItemsIssued
2436
2437     my $count = CountItemsIssued( $biblionumber );
2438
2439 =cut
2440
2441 sub CountItemsIssued {
2442     my ($biblionumber) = @_;
2443     my $dbh            = C4::Context->dbh;
2444     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2445     $sth->execute($biblionumber);
2446     my $row = $sth->fetchrow_hashref();
2447     return $row->{'issuedCount'};
2448 }
2449
2450 =head2 ModZebra
2451
2452     ModZebra( $record_number, $op, $server );
2453
2454 $record_number is the authid or biblionumber we want to index
2455
2456 $op is the operation: specialUpdate or recordDelete
2457
2458 $server is authorityserver or biblioserver
2459
2460 =cut
2461
2462 sub ModZebra {
2463     my ( $record_number, $op, $server ) = @_;
2464     Koha::Logger->get->debug("ModZebra: updates requested for: $record_number $op $server");
2465     my $dbh = C4::Context->dbh;
2466
2467     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2468     # at the same time
2469     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2470     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2471     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2472     WHERE server = ?
2473         AND   biblio_auth_number = ?
2474         AND   operation = ?
2475         AND   done = 0";
2476     my $check_sth = $dbh->prepare_cached($check_sql);
2477     $check_sth->execute( $server, $record_number, $op );
2478     my ($count) = $check_sth->fetchrow_array;
2479     $check_sth->finish();
2480     if ( $count == 0 ) {
2481         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2482         $sth->execute( $record_number, $server, $op );
2483         $sth->finish;
2484     }
2485 }
2486
2487 =head2 EmbedItemsInMarcBiblio
2488
2489     EmbedItemsInMarcBiblio({
2490         marc_record  => $marc,
2491         biblionumber => $biblionumber,
2492         item_numbers => $itemnumbers,
2493         opac         => $opac });
2494
2495 Given a MARC::Record object containing a bib record,
2496 modify it to include the items attached to it as 9XX
2497 per the bib's MARC framework.
2498 if $itemnumbers is defined, only specified itemnumbers are embedded.
2499
2500 If $opac is true, then opac-relevant suppressions are included.
2501
2502 If opac filtering will be done, borcat should be passed to properly
2503 override if necessary.
2504
2505 =cut
2506
2507 sub EmbedItemsInMarcBiblio {
2508     my ($params) = @_;
2509     my ($marc, $biblionumber, $itemnumbers, $opac, $borcat);
2510     $marc = $params->{marc_record};
2511     if ( !$marc ) {
2512         carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2513         return;
2514     }
2515     $biblionumber = $params->{biblionumber};
2516     $itemnumbers = $params->{item_numbers};
2517     $opac = $params->{opac};
2518     $borcat = $params->{borcat} // q{};
2519
2520     $itemnumbers = [] unless defined $itemnumbers;
2521
2522     my $frameworkcode = GetFrameworkCode($biblionumber);
2523     _strip_item_fields($marc, $frameworkcode);
2524
2525     # ... and embed the current items
2526     my $dbh = C4::Context->dbh;
2527     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2528     $sth->execute($biblionumber);
2529     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber" );
2530
2531     my @item_fields; # Array holding the actual MARC data for items to be included.
2532     my @items;       # Array holding items which are both in the list (sitenumbers)
2533                      # and on this biblionumber
2534
2535     # Flag indicating if there is potential hiding.
2536     my $opachiddenitems = $opac
2537       && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2538
2539     while ( my ($itemnumber) = $sth->fetchrow_array ) {
2540         next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2541         my $item;
2542         if ( $opachiddenitems ) {
2543             $item = Koha::Items->find($itemnumber);
2544             $item = $item ? $item->unblessed : undef;
2545         }
2546         push @items, { itemnumber => $itemnumber, item => $item };
2547     }
2548     my @items2pass = map { $_->{item} } @items;
2549     my @hiddenitems =
2550       $opachiddenitems
2551       ? C4::Items::GetHiddenItemnumbers({
2552             items  => \@items2pass,
2553             borcat => $borcat })
2554       : ();
2555     # Convert to a hash for quick searching
2556     my %hiddenitems = map { $_ => 1 } @hiddenitems;
2557     foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2558         next if $hiddenitems{$itemnumber};
2559         my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2560         push @item_fields, $item_marc->field($itemtag);
2561     }
2562     $marc->append_fields(@item_fields);
2563 }
2564
2565 =head1 INTERNAL FUNCTIONS
2566
2567 =head2 _koha_marc_update_bib_ids
2568
2569
2570   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2571
2572 Internal function to add or update biblionumber and biblioitemnumber to
2573 the MARC XML.
2574
2575 =cut
2576
2577 sub _koha_marc_update_bib_ids {
2578     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2579
2580     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber" );
2581     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
2582     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber" );
2583     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
2584
2585     if ( $biblio_tag < 10 ) {
2586         C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
2587     } else {
2588         C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
2589     }
2590     if ( $biblioitem_tag < 10 ) {
2591         C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
2592     } else {
2593         C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
2594     }
2595 }
2596
2597 =head2 _koha_marc_update_biblioitem_cn_sort
2598
2599   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2600
2601 Given a MARC bib record and the biblioitem hash, update the
2602 subfield that contains a copy of the value of biblioitems.cn_sort.
2603
2604 =cut
2605
2606 sub _koha_marc_update_biblioitem_cn_sort {
2607     my $marc          = shift;
2608     my $biblioitem    = shift;
2609     my $frameworkcode = shift;
2610
2611     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort" );
2612     return unless $biblioitem_tag;
2613
2614     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2615
2616     if ( my $field = $marc->field($biblioitem_tag) ) {
2617         $field->delete_subfield( code => $biblioitem_subfield );
2618         if ( $cn_sort ne '' ) {
2619             $field->add_subfields( $biblioitem_subfield => $cn_sort );
2620         }
2621     } else {
2622
2623         # if we get here, no biblioitem tag is present in the MARC record, so
2624         # we'll create it if $cn_sort is not empty -- this would be
2625         # an odd combination of events, however
2626         if ($cn_sort) {
2627             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
2628         }
2629     }
2630 }
2631
2632 =head2 _koha_modify_biblio
2633
2634   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2635
2636 Internal function for updating the biblio table
2637
2638 =cut
2639
2640 sub _koha_modify_biblio {
2641     my ( $dbh, $biblio, $frameworkcode ) = @_;
2642     my $error;
2643
2644     my $query = "
2645         UPDATE biblio
2646         SET    frameworkcode = ?,
2647                author = ?,
2648                title = ?,
2649                subtitle = ?,
2650                medium = ?,
2651                part_number = ?,
2652                part_name = ?,
2653                unititle = ?,
2654                notes = ?,
2655                serial = ?,
2656                seriestitle = ?,
2657                copyrightdate = ?,
2658                abstract = ?
2659         WHERE  biblionumber = ?
2660         "
2661       ;
2662     my $sth = $dbh->prepare($query);
2663
2664     $sth->execute(
2665         $frameworkcode,        $biblio->{'author'},      $biblio->{'title'},       $biblio->{'subtitle'},
2666         $biblio->{'medium'},   $biblio->{'part_number'}, $biblio->{'part_name'},   $biblio->{'unititle'},
2667         $biblio->{'notes'},    $biblio->{'serial'},      $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef,
2668         $biblio->{'abstract'}, $biblio->{'biblionumber'}
2669     ) if $biblio->{'biblionumber'};
2670
2671     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2672         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
2673         warn $error;
2674     }
2675     return ( $biblio->{'biblionumber'}, $error );
2676 }
2677
2678 =head2 _koha_modify_biblioitem_nonmarc
2679
2680   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2681
2682 =cut
2683
2684 sub _koha_modify_biblioitem_nonmarc {
2685     my ( $dbh, $biblioitem ) = @_;
2686     my $error;
2687
2688     # re-calculate the cn_sort, it may have changed
2689     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2690
2691     my $query = "UPDATE biblioitems
2692     SET biblionumber    = ?,
2693         volume          = ?,
2694         number          = ?,
2695         itemtype        = ?,
2696         isbn            = ?,
2697         issn            = ?,
2698         publicationyear = ?,
2699         publishercode   = ?,
2700         volumedate      = ?,
2701         volumedesc      = ?,
2702         collectiontitle = ?,
2703         collectionissn  = ?,
2704         collectionvolume= ?,
2705         editionstatement= ?,
2706         editionresponsibility = ?,
2707         illus           = ?,
2708         pages           = ?,
2709         notes           = ?,
2710         size            = ?,
2711         place           = ?,
2712         lccn            = ?,
2713         url             = ?,
2714         cn_source       = ?,
2715         cn_class        = ?,
2716         cn_item         = ?,
2717         cn_suffix       = ?,
2718         cn_sort         = ?,
2719         totalissues     = ?,
2720         ean             = ?,
2721         agerestriction  = ?
2722         where biblioitemnumber = ?
2723         ";
2724     my $sth = $dbh->prepare($query);
2725     $sth->execute(
2726         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
2727         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
2728         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
2729         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
2730         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
2731         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
2732         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
2733         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
2734     );
2735     if ( $dbh->errstr ) {
2736         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
2737         warn $error;
2738     }
2739     return ( $biblioitem->{'biblioitemnumber'}, $error );
2740 }
2741
2742 =head2 _koha_delete_biblio
2743
2744   $error = _koha_delete_biblio($dbh,$biblionumber);
2745
2746 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2747
2748 C<$dbh> - the database handle
2749
2750 C<$biblionumber> - the biblionumber of the biblio to be deleted
2751
2752 =cut
2753
2754 # FIXME: add error handling
2755
2756 sub _koha_delete_biblio {
2757     my ( $dbh, $biblionumber ) = @_;
2758
2759     # get all the data for this biblio
2760     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2761     $sth->execute($biblionumber);
2762
2763     # FIXME There is a transaction in _koha_delete_biblio_metadata
2764     # But actually all the following should be done inside a single transaction
2765     if ( my $data = $sth->fetchrow_hashref ) {
2766
2767         # save the record in deletedbiblio
2768         # find the fields to save
2769         my $query = "INSERT INTO deletedbiblio SET ";
2770         my @bind  = ();
2771         foreach my $temp ( keys %$data ) {
2772             $query .= "$temp = ?,";
2773             push( @bind, $data->{$temp} );
2774         }
2775
2776         # replace the last , by ",?)"
2777         $query =~ s/\,$//;
2778         my $bkup_sth = $dbh->prepare($query);
2779         $bkup_sth->execute(@bind);
2780         $bkup_sth->finish;
2781
2782         _koha_delete_biblio_metadata( $biblionumber );
2783
2784         # delete the biblio
2785         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2786         $sth2->execute($biblionumber);
2787         # update the timestamp (Bugzilla 7146)
2788         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
2789         $sth2->execute($biblionumber);
2790         $sth2->finish;
2791     }
2792     $sth->finish;
2793     return;
2794 }
2795
2796 =head2 _koha_delete_biblioitems
2797
2798   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2799
2800 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2801
2802 C<$dbh> - the database handle
2803 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2804
2805 =cut
2806
2807 # FIXME: add error handling
2808
2809 sub _koha_delete_biblioitems {
2810     my ( $dbh, $biblioitemnumber ) = @_;
2811
2812     # get all the data for this biblioitem
2813     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2814     $sth->execute($biblioitemnumber);
2815
2816     if ( my $data = $sth->fetchrow_hashref ) {
2817
2818         # save the record in deletedbiblioitems
2819         # find the fields to save
2820         my $query = "INSERT INTO deletedbiblioitems SET ";
2821         my @bind  = ();
2822         foreach my $temp ( keys %$data ) {
2823             $query .= "$temp = ?,";
2824             push( @bind, $data->{$temp} );
2825         }
2826
2827         # replace the last , by ",?)"
2828         $query =~ s/\,$//;
2829         my $bkup_sth = $dbh->prepare($query);
2830         $bkup_sth->execute(@bind);
2831         $bkup_sth->finish;
2832
2833         # delete the biblioitem
2834         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2835         $sth2->execute($biblioitemnumber);
2836         # update the timestamp (Bugzilla 7146)
2837         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
2838         $sth2->execute($biblioitemnumber);
2839         $sth2->finish;
2840     }
2841     $sth->finish;
2842     return;
2843 }
2844
2845 =head2 _koha_delete_biblio_metadata
2846
2847   $error = _koha_delete_biblio_metadata($biblionumber);
2848
2849 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
2850
2851 =cut
2852
2853 sub _koha_delete_biblio_metadata {
2854     my ($biblionumber) = @_;
2855
2856     my $dbh    = C4::Context->dbh;
2857     my $schema = Koha::Database->new->schema;
2858     $schema->txn_do(
2859         sub {
2860             $dbh->do( q|
2861                 INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata)
2862                 SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=?
2863             |,  undef, $biblionumber );
2864             $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
2865                 undef, $biblionumber );
2866         }
2867     );
2868 }
2869
2870 =head1 UNEXPORTED FUNCTIONS
2871
2872 =head2 ModBiblioMarc
2873
2874   ModBiblioMarc($newrec,$biblionumber);
2875
2876 Add MARC XML data for a biblio to koha
2877
2878 Function exported, but should NOT be used, unless you really know what you're doing
2879
2880 =cut
2881
2882 sub ModBiblioMarc {
2883     # pass the MARC::Record to this function, and it will create the records in
2884     # the marcxml field
2885     my ( $record, $biblionumber, $params ) = @_;
2886     if ( !$record ) {
2887         carp 'ModBiblioMarc passed an undefined record';
2888         return;
2889     }
2890
2891     my $skip_record_index = $params->{skip_record_index} || 0;
2892
2893     # Clone record as it gets modified
2894     $record = $record->clone();
2895     my $dbh    = C4::Context->dbh;
2896     my @fields = $record->fields();
2897     my $encoding = C4::Context->preference("marcflavour");
2898
2899     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
2900     if ( $encoding eq "UNIMARC" ) {
2901         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
2902         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
2903         my $string = $record->subfield( 100, "a" );
2904         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
2905             my $f100 = $record->field(100);
2906             $record->delete_field($f100);
2907         } else {
2908             $string = POSIX::strftime( "%Y%m%d", localtime );
2909             $string =~ s/\-//g;
2910             $string = sprintf( "%-*s", 35, $string );
2911             substr ( $string, 22, 3, $defaultlanguage);
2912         }
2913         substr( $string, 25, 3, "y50" );
2914         unless ( $record->subfield( 100, "a" ) ) {
2915             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
2916         }
2917     }
2918
2919     #enhancement 5374: update transaction date (005) for marc21/unimarc
2920     if($encoding =~ /MARC21|UNIMARC/) {
2921       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
2922         # YY MM DD HH MM SS (update year and month)
2923       my $f005= $record->field('005');
2924       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
2925     }
2926
2927     my $metadata = {
2928         biblionumber => $biblionumber,
2929         format       => 'marcxml',
2930         schema       => C4::Context->preference('marcflavour'),
2931     };
2932     $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation
2933
2934     my $m_rs = Koha::Biblio::Metadatas->find($metadata) //
2935         Koha::Biblio::Metadata->new($metadata);
2936
2937     my $userenv = C4::Context->userenv;
2938     if ($userenv) {
2939         my $borrowernumber = $userenv->{number};
2940         my $borrowername = join ' ', map { $_ // q{} } @$userenv{qw(firstname surname)};
2941         unless ($m_rs->in_storage) {
2942             Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber);
2943             Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername);
2944         }
2945         Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber);
2946         Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername);
2947     }
2948
2949     $m_rs->metadata( $record->as_xml_record($encoding) );
2950     $m_rs->store;
2951
2952     unless ( $skip_record_index ) {
2953         my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
2954         $indexer->index_records( $biblionumber, "specialUpdate", "biblioserver" );
2955     }
2956
2957     return $biblionumber;
2958 }
2959
2960 =head2 prepare_host_field
2961
2962 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
2963 Generate the host item entry for an analytic child entry
2964
2965 =cut
2966
2967 sub prepare_host_field {
2968     my ( $hostbiblio, $marcflavour ) = @_;
2969     $marcflavour ||= C4::Context->preference('marcflavour');
2970     my $host = GetMarcBiblio({ biblionumber => $hostbiblio });
2971     # unfortunately as_string does not 'do the right thing'
2972     # if field returns undef
2973     my %sfd;
2974     my $field;
2975     my $host_field;
2976     if ( $marcflavour eq 'MARC21' ) {
2977         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
2978             my $s = $field->as_string('ab');
2979             if ($s) {
2980                 $sfd{a} = $s;
2981             }
2982         }
2983         if ( $field = $host->field('245') ) {
2984             my $s = $field->as_string('a');
2985             if ($s) {
2986                 $sfd{t} = $s;
2987             }
2988         }
2989         if ( $field = $host->field('260') ) {
2990             my $s = $field->as_string('abc');
2991             if ($s) {
2992                 $sfd{d} = $s;
2993             }
2994         }
2995         if ( $field = $host->field('240') ) {
2996             my $s = $field->as_string();
2997             if ($s) {
2998                 $sfd{b} = $s;
2999             }
3000         }
3001         if ( $field = $host->field('022') ) {
3002             my $s = $field->as_string('a');
3003             if ($s) {
3004                 $sfd{x} = $s;
3005             }
3006         }
3007         if ( $field = $host->field('020') ) {
3008             my $s = $field->as_string('a');
3009             if ($s) {
3010                 $sfd{z} = $s;
3011             }
3012         }
3013         if ( $field = $host->field('001') ) {
3014             $sfd{w} = $field->data(),;
3015         }
3016         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3017         return $host_field;
3018     }
3019     elsif ( $marcflavour eq 'UNIMARC' ) {
3020         #author
3021         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3022             my $s = $field->as_string('ab');
3023             if ($s) {
3024                 $sfd{a} = $s;
3025             }
3026         }
3027         #title
3028         if ( $field = $host->field('200') ) {
3029             my $s = $field->as_string('a');
3030             if ($s) {
3031                 $sfd{t} = $s;
3032             }
3033         }
3034         #place of publicaton
3035         if ( $field = $host->field('210') ) {
3036             my $s = $field->as_string('a');
3037             if ($s) {
3038                 $sfd{c} = $s;
3039             }
3040         }
3041         #date of publication
3042         if ( $field = $host->field('210') ) {
3043             my $s = $field->as_string('d');
3044             if ($s) {
3045                 $sfd{d} = $s;
3046             }
3047         }
3048         #edition statement
3049         if ( $field = $host->field('205') ) {
3050             my $s = $field->as_string();
3051             if ($s) {
3052                 $sfd{e} = $s;
3053             }
3054         }
3055         #URL
3056         if ( $field = $host->field('856') ) {
3057             my $s = $field->as_string('u');
3058             if ($s) {
3059                 $sfd{u} = $s;
3060             }
3061         }
3062         #ISSN
3063         if ( $field = $host->field('011') ) {
3064             my $s = $field->as_string('a');
3065             if ($s) {
3066                 $sfd{x} = $s;
3067             }
3068         }
3069         #ISBN
3070         if ( $field = $host->field('010') ) {
3071             my $s = $field->as_string('a');
3072             if ($s) {
3073                 $sfd{y} = $s;
3074             }
3075         }
3076         if ( $field = $host->field('001') ) {
3077             $sfd{0} = $field->data(),;
3078         }
3079         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3080         return $host_field;
3081     }
3082     return;
3083 }
3084
3085
3086 =head2 UpdateTotalIssues
3087
3088   UpdateTotalIssues($biblionumber, $increase, [$value])
3089
3090 Update the total issue count for a particular bib record.
3091
3092 =over 4
3093
3094 =item C<$biblionumber> is the biblionumber of the bib to update
3095
3096 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3097
3098 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3099
3100 =back
3101
3102 =cut
3103
3104 sub UpdateTotalIssues {
3105     my ($biblionumber, $increase, $value, $skip_holds_queue) = @_;
3106     my $totalissues;
3107
3108     my $record = GetMarcBiblio({ biblionumber => $biblionumber });
3109     unless ($record) {
3110         carp "UpdateTotalIssues could not get biblio record";
3111         return;
3112     }
3113     my $biblio = Koha::Biblios->find( $biblionumber );
3114     unless ($biblio) {
3115         carp "UpdateTotalIssues could not get datas of biblio";
3116         return;
3117     }
3118     my $biblioitem = $biblio->biblioitem;
3119     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField( 'biblioitems.totalissues' );
3120     unless ($totalissuestag) {
3121         return 1; # There is nothing to do
3122     }
3123
3124     if (defined $value) {
3125         $totalissues = $value;
3126     } else {
3127         $totalissues = $biblioitem->totalissues + $increase;
3128     }
3129
3130      my $field = $record->field($totalissuestag);
3131      if (defined $field) {
3132          $field->update( $totalissuessubfield => $totalissues );
3133      } else {
3134          $field = MARC::Field->new($totalissuestag, '0', '0',
3135                  $totalissuessubfield => $totalissues);
3136          $record->insert_grouped_field($field);
3137      }
3138
3139      return ModBiblio($record, $biblionumber, $biblio->frameworkcode, { skip_holds_queue => $skip_holds_queue });
3140 }
3141
3142 =head2 RemoveAllNsb
3143
3144     &RemoveAllNsb($record);
3145
3146 Removes all nsb/nse chars from a record
3147
3148 =cut
3149
3150 sub RemoveAllNsb {
3151     my $record = shift;
3152     if (!$record) {
3153         carp 'RemoveAllNsb called with undefined record';
3154         return;
3155     }
3156
3157     SetUTF8Flag($record);
3158
3159     foreach my $field ($record->fields()) {
3160         if ($field->is_control_field()) {
3161             $field->update(nsb_clean($field->data()));
3162         } else {
3163             my @subfields = $field->subfields();
3164             my @new_subfields;
3165             foreach my $subfield (@subfields) {
3166                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3167             }
3168             if (scalar(@new_subfields) > 0) {
3169                 my $new_field;
3170                 eval {
3171                     $new_field = MARC::Field->new(
3172                         $field->tag(),
3173                         $field->indicator(1),
3174                         $field->indicator(2),
3175                         @new_subfields
3176                     );
3177                 };
3178                 if ($@) {
3179                     warn "error in RemoveAllNsb : $@";
3180                 } else {
3181                     $field->replace_with($new_field);
3182                 }
3183             }
3184         }
3185     }
3186
3187     return $record;
3188 }
3189
3190 =head2 ApplyMarcOverlayRules
3191
3192     my $record = ApplyMarcOverlayRules($params)
3193
3194 Applies marc merge rules to a record.
3195
3196 C<$params> is expected to be a hashref with below keys defined.
3197
3198 =over 4
3199
3200 =item C<biblionumber>
3201 biblionumber of old record
3202
3203 =item C<record>
3204 Incoming record that will be merged with old record
3205
3206 =item C<overlay_context>
3207 hashref containing at least one context module and filter value on
3208 the form {module => filter, ...}.
3209
3210 =back
3211
3212 Returns:
3213
3214 =over 4
3215
3216 =item C<$record>
3217
3218 Merged MARC record based with merge rules for C<context> applied. If no old
3219 record for C<biblionumber> can be found, C<record> is returned unchanged.
3220 Default action when no matching context is found to return C<record> unchanged.
3221 If no rules are found for a certain field tag the default is to overwrite with
3222 fields with this field tag from C<record>.
3223
3224 =back
3225
3226 =cut
3227
3228 sub ApplyMarcOverlayRules {
3229     my ($params) = @_;
3230     my $biblionumber = $params->{biblionumber};
3231     my $incoming_record = $params->{record};
3232
3233     if (!$biblionumber) {
3234         carp 'ApplyMarcOverlayRules called on undefined biblionumber';
3235         return;
3236     }
3237     if (!$incoming_record) {
3238         carp 'ApplyMarcOverlayRules called on undefined record';
3239         return;
3240     }
3241     my $old_record = GetMarcBiblio({ biblionumber => $biblionumber });
3242
3243     # Skip overlay rules if called with no context
3244     if ($old_record && defined $params->{overlay_context}) {
3245         return Koha::MarcOverlayRules->merge_records($old_record, $incoming_record, $params->{overlay_context});
3246     }
3247     return $incoming_record;
3248 }
3249
3250 =head2 _after_biblio_action_hooks
3251
3252 Helper method that takes care of calling all plugin hooks
3253
3254 =cut
3255
3256 sub _after_biblio_action_hooks {
3257     my ( $args ) = @_;
3258
3259     my $biblio_id = $args->{biblio_id};
3260     my $action    = $args->{action};
3261
3262     my $biblio = Koha::Biblios->find( $biblio_id );
3263     Koha::Plugins->call(
3264         'after_biblio_action',
3265         {
3266             action    => $action,
3267             biblio    => $biblio,
3268             biblio_id => $biblio_id,
3269         }
3270     );
3271 }
3272
3273 1;
3274
3275 __END__
3276
3277 =head1 AUTHOR
3278
3279 Koha Development Team <http://koha-community.org/>
3280
3281 Paul POULAIN paul.poulain@free.fr
3282
3283 Joshua Ferraro jmf@liblime.com
3284
3285 =cut