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