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