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