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