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