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