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             $url =~ s/^\s+|\s+$//g; # trim
1992             my $marcurl;
1993             if ( $marcflavour eq 'MARC21' ) {
1994                 my $s3   = $field->subfield('3');
1995                 my $link = $field->subfield('y');
1996                 unless ( $url =~ /^\w+:/ ) {
1997                     if ( $field->indicator(1) eq '7' ) {
1998                         $url = $field->subfield('2') . "://" . $url;
1999                     } elsif ( $field->indicator(1) eq '1' ) {
2000                         $url = 'ftp://' . $url;
2001                     } else {
2002
2003                         #  properly, this should be if ind1=4,
2004                         #  however we will assume http protocol since we're building a link.
2005                         $url = 'http://' . $url;
2006                     }
2007                 }
2008
2009                 # TODO handle ind 2 (relationship)
2010                 $marcurl = {
2011                     MARCURL => $url,
2012                     notes   => \@notes,
2013                 };
2014                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
2015                 $marcurl->{'part'} = $s3 if ($link);
2016                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
2017             } else {
2018                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
2019                 $marcurl->{'MARCURL'} = $url;
2020             }
2021             push @marcurls, $marcurl;
2022         }
2023     }
2024     return \@marcurls;
2025 }
2026
2027 =head2 GetMarcSeries
2028
2029   $marcseriesarray = GetMarcSeries($record,$marcflavour);
2030
2031 Get all series from the MARC record and returns them in an array.
2032 The series are stored in different fields depending on MARC flavour
2033
2034 =cut
2035
2036 sub GetMarcSeries {
2037     my ( $record, $marcflavour ) = @_;
2038     if (!$record) {
2039         carp 'GetMarcSeries called on undefined record';
2040         return;
2041     }
2042
2043     my ( $mintag, $maxtag, $fields_filter );
2044     if ( $marcflavour eq "UNIMARC" ) {
2045         $mintag = "225";
2046         $maxtag = "225";
2047         $fields_filter = '2..';
2048     } else {    # marc21/normarc
2049         $mintag = "440";
2050         $maxtag = "490";
2051         $fields_filter = '4..';
2052     }
2053
2054     my @marcseries;
2055     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
2056
2057     foreach my $field ( $record->field($fields_filter) ) {
2058         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
2059         my @subfields_loop;
2060         my @subfields = $field->subfields();
2061         my @link_loop;
2062
2063         for my $series_subfield (@subfields) {
2064
2065             # ignore $9, used for authority link
2066             next if ( $series_subfield->[0] eq '9' );
2067
2068             my $volume_number;
2069             my $code      = $series_subfield->[0];
2070             my $value     = $series_subfield->[1];
2071             my $linkvalue = $value;
2072             $linkvalue =~ s/(\(|\))//g;
2073
2074             # see if this is an instance of a volume
2075             if ( $code eq 'v' ) {
2076                 $volume_number = 1;
2077             }
2078
2079             push @link_loop, {
2080                 'link' => $linkvalue,
2081                 operator => (scalar @link_loop) ? ' and ' : undef
2082             };
2083
2084             if ($volume_number) {
2085                 push @subfields_loop, { volumenum => $value };
2086             } else {
2087                 push @subfields_loop, {
2088                     code      => $code,
2089                     value     => $value,
2090                     link_loop => \@link_loop,
2091                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
2092                     volumenum => $volume_number,
2093                 }
2094             }
2095         }
2096         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2097
2098     }
2099     return \@marcseries;
2100 }    #end getMARCseriess
2101
2102 =head2 GetMarcHosts
2103
2104   $marchostsarray = GetMarcHosts($record,$marcflavour);
2105
2106 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2107
2108 =cut
2109
2110 sub GetMarcHosts {
2111     my ( $record, $marcflavour ) = @_;
2112     if (!$record) {
2113         carp 'GetMarcHosts called on undefined record';
2114         return;
2115     }
2116
2117     my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2118     $marcflavour ||="MARC21";
2119     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2120         $tag = "773";
2121         $title_subf = "t";
2122         $bibnumber_subf ="0";
2123         $itemnumber_subf='9';
2124     }
2125     elsif ($marcflavour eq "UNIMARC") {
2126         $tag = "461";
2127         $title_subf = "t";
2128         $bibnumber_subf ="0";
2129         $itemnumber_subf='9';
2130     };
2131
2132     my @marchosts;
2133
2134     foreach my $field ( $record->field($tag)) {
2135
2136         my @fields_loop;
2137
2138         my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2139         my $hosttitle = $field->subfield($title_subf);
2140         my $hostitemnumber=$field->subfield($itemnumber_subf);
2141         push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2142         push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2143
2144         }
2145     my $marchostsarray = \@marchosts;
2146     return $marchostsarray;
2147 }
2148
2149 =head2 UpsertMarcSubfield
2150
2151     my $record = C4::Biblio::UpsertMarcSubfield($MARC::Record, $fieldTag, $subfieldCode, $subfieldContent);
2152
2153 =cut
2154
2155 sub UpsertMarcSubfield {
2156     my ($record, $tag, $code, $content) = @_;
2157     my $f = $record->field($tag);
2158
2159     if ($f) {
2160         $f->update( $code => $content );
2161     }
2162     else {
2163         my $f = MARC::Field->new( $tag, '', '', $code => $content);
2164         $record->insert_fields_ordered( $f );
2165     }
2166 }
2167
2168 =head2 UpsertMarcControlField
2169
2170     my $record = C4::Biblio::UpsertMarcControlField($MARC::Record, $fieldTag, $content);
2171
2172 =cut
2173
2174 sub UpsertMarcControlField {
2175     my ($record, $tag, $content) = @_;
2176     die "UpsertMarcControlField() \$tag '$tag' is not a control field\n" unless 0+$tag < 10;
2177     my $f = $record->field($tag);
2178
2179     if ($f) {
2180         $f->update( $content );
2181     }
2182     else {
2183         my $f = MARC::Field->new($tag, $content);
2184         $record->insert_fields_ordered( $f );
2185     }
2186 }
2187
2188 =head2 GetFrameworkCode
2189
2190   $frameworkcode = GetFrameworkCode( $biblionumber )
2191
2192 =cut
2193
2194 sub GetFrameworkCode {
2195     my ($biblionumber) = @_;
2196     my $dbh            = C4::Context->dbh;
2197     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2198     $sth->execute($biblionumber);
2199     my ($frameworkcode) = $sth->fetchrow;
2200     return $frameworkcode;
2201 }
2202
2203 =head2 TransformKohaToMarc
2204
2205     $record = TransformKohaToMarc( $hash )
2206
2207 This function builds partial MARC::Record from a hash
2208 Hash entries can be from biblio or biblioitems.
2209
2210 This function is called in acquisition module, to create a basic catalogue
2211 entry from user entry
2212
2213 =cut
2214
2215
2216 sub TransformKohaToMarc {
2217     my $hash = shift;
2218     my $record = MARC::Record->new();
2219     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2220     # FIXME Do not we want to get the marc subfield structure for the biblio framework?
2221     my $mss = GetMarcSubfieldStructure();
2222     my $tag_hr = {};
2223     while ( my ($kohafield, $value) = each %$hash ) {
2224         next unless exists $mss->{$kohafield};
2225         next unless $mss->{$kohafield};
2226         my $tagfield    = $mss->{$kohafield}{tagfield} . '';
2227         my $tagsubfield = $mss->{$kohafield}{tagsubfield};
2228         foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2229             next if $value eq '';
2230             $tag_hr->{$tagfield} //= [];
2231             push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
2232         }
2233     }
2234     foreach my $tag (sort keys %$tag_hr) {
2235         my @sfl = @{$tag_hr->{$tag}};
2236         @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2237         @sfl = map { @{$_}; } @sfl;
2238         $record->insert_fields_ordered(
2239             MARC::Field->new($tag, " ", " ", @sfl)
2240         );
2241     }
2242     return $record;
2243 }
2244
2245 =head2 PrepHostMarcField
2246
2247     $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2248
2249 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2250
2251 =cut
2252
2253 sub PrepHostMarcField {
2254     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2255     $marcflavour ||="MARC21";
2256
2257     require C4::Items;
2258     my $hostrecord = GetMarcBiblio($hostbiblionumber);
2259         my $item = C4::Items::GetItem($hostitemnumber);
2260
2261         my $hostmarcfield;
2262     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2263
2264         #main entry
2265         my $mainentry;
2266         if ($hostrecord->subfield('100','a')){
2267             $mainentry = $hostrecord->subfield('100','a');
2268         } elsif ($hostrecord->subfield('110','a')){
2269             $mainentry = $hostrecord->subfield('110','a');
2270         } else {
2271             $mainentry = $hostrecord->subfield('111','a');
2272         }
2273
2274         # qualification info
2275         my $qualinfo;
2276         if (my $field260 = $hostrecord->field('260')){
2277             $qualinfo =  $field260->as_string( 'abc' );
2278         }
2279
2280
2281         #other fields
2282         my $ed = $hostrecord->subfield('250','a');
2283         my $barcode = $item->{'barcode'};
2284         my $title = $hostrecord->subfield('245','a');
2285
2286         # record control number, 001 with 003 and prefix
2287         my $recctrlno;
2288         if ($hostrecord->field('001')){
2289             $recctrlno = $hostrecord->field('001')->data();
2290             if ($hostrecord->field('003')){
2291                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2292             }
2293         }
2294
2295         # issn/isbn
2296         my $issn = $hostrecord->subfield('022','a');
2297         my $isbn = $hostrecord->subfield('020','a');
2298
2299
2300         $hostmarcfield = MARC::Field->new(
2301                 773, '0', '',
2302                 '0' => $hostbiblionumber,
2303                 '9' => $hostitemnumber,
2304                 'a' => $mainentry,
2305                 'b' => $ed,
2306                 'd' => $qualinfo,
2307                 'o' => $barcode,
2308                 't' => $title,
2309                 'w' => $recctrlno,
2310                 'x' => $issn,
2311                 'z' => $isbn
2312                 );
2313     } elsif ($marcflavour eq "UNIMARC") {
2314         $hostmarcfield = MARC::Field->new(
2315             461, '', '',
2316             '0' => $hostbiblionumber,
2317             't' => $hostrecord->subfield('200','a'),
2318             '9' => $hostitemnumber
2319         );
2320     };
2321
2322     return $hostmarcfield;
2323 }
2324
2325 =head2 TransformHtmlToXml
2326
2327   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2328                              $ind_tag, $auth_type )
2329
2330 $auth_type contains :
2331
2332 =over
2333
2334 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2335
2336 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2337
2338 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2339
2340 =back
2341
2342 =cut
2343
2344 sub TransformHtmlToXml {
2345     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2346     # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2347
2348     my $xml = MARC::File::XML::header('UTF-8');
2349     $xml .= "<record>\n";
2350     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2351     MARC::File::XML->default_record_format($auth_type);
2352
2353     # in UNIMARC, field 100 contains the encoding
2354     # check that there is one, otherwise the
2355     # MARC::Record->new_from_xml will fail (and Koha will die)
2356     my $unimarc_and_100_exist = 0;
2357     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
2358     my $prevvalue;
2359     my $prevtag = -1;
2360     my $first   = 1;
2361     my $j       = -1;
2362     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2363
2364         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2365
2366             # if we have a 100 field and it's values are not correct, skip them.
2367             # if we don't have any valid 100 field, we will create a default one at the end
2368             my $enc = substr( @$values[$i], 26, 2 );
2369             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2370                 $unimarc_and_100_exist = 1;
2371             } else {
2372                 next;
2373             }
2374         }
2375         @$values[$i] =~ s/&/&amp;/g;
2376         @$values[$i] =~ s/</&lt;/g;
2377         @$values[$i] =~ s/>/&gt;/g;
2378         @$values[$i] =~ s/"/&quot;/g;
2379         @$values[$i] =~ s/'/&apos;/g;
2380
2381         if ( ( @$tags[$i] ne $prevtag ) ) {
2382             $j++ unless ( @$tags[$i] eq "" );
2383             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2384             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2385             my $ind1       = _default_ind_to_space($indicator1);
2386             my $ind2;
2387             if ( @$indicator[$j] ) {
2388                 $ind2 = _default_ind_to_space($indicator2);
2389             } else {
2390                 warn "Indicator in @$tags[$i] is empty";
2391                 $ind2 = " ";
2392             }
2393             if ( !$first ) {
2394                 $xml .= "</datafield>\n";
2395                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2396                     && ( @$values[$i] ne "" ) ) {
2397                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2398                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2399                     $first = 0;
2400                 } else {
2401                     $first = 1;
2402                 }
2403             } else {
2404                 if ( @$values[$i] ne "" ) {
2405
2406                     # leader
2407                     if ( @$tags[$i] eq "000" ) {
2408                         $xml .= "<leader>@$values[$i]</leader>\n";
2409                         $first = 1;
2410
2411                         # rest of the fixed fields
2412                     } elsif ( @$tags[$i] < 10 ) {
2413                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2414                         $first = 1;
2415                     } else {
2416                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2417                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2418                         $first = 0;
2419                     }
2420                 }
2421             }
2422         } else {    # @$tags[$i] eq $prevtag
2423             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2424             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2425             my $ind1       = _default_ind_to_space($indicator1);
2426             my $ind2;
2427             if ( @$indicator[$j] ) {
2428                 $ind2 = _default_ind_to_space($indicator2);
2429             } else {
2430                 warn "Indicator in @$tags[$i] is empty";
2431                 $ind2 = " ";
2432             }
2433             if ( @$values[$i] eq "" ) {
2434             } else {
2435                 if ($first) {
2436                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2437                     $first = 0;
2438                 }
2439                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2440             }
2441         }
2442         $prevtag = @$tags[$i];
2443     }
2444     $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2445     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2446
2447         #     warn "SETTING 100 for $auth_type";
2448         my $string = strftime( "%Y%m%d", localtime(time) );
2449
2450         # set 50 to position 26 is biblios, 13 if authorities
2451         my $pos = 26;
2452         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2453         $string = sprintf( "%-*s", 35, $string );
2454         substr( $string, $pos, 6, "50" );
2455         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2456         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2457         $xml .= "</datafield>\n";
2458     }
2459     $xml .= "</record>\n";
2460     $xml .= MARC::File::XML::footer();
2461     return $xml;
2462 }
2463
2464 =head2 _default_ind_to_space
2465
2466 Passed what should be an indicator returns a space
2467 if its undefined or zero length
2468
2469 =cut
2470
2471 sub _default_ind_to_space {
2472     my $s = shift;
2473     if ( !defined $s || $s eq q{} ) {
2474         return ' ';
2475     }
2476     return $s;
2477 }
2478
2479 =head2 TransformHtmlToMarc
2480
2481     L<$record> = TransformHtmlToMarc(L<$cgi>)
2482     L<$cgi> is the CGI object which containts the values for subfields
2483     {
2484         'tag_010_indicator1_531951' ,
2485         'tag_010_indicator2_531951' ,
2486         'tag_010_code_a_531951_145735' ,
2487         'tag_010_subfield_a_531951_145735' ,
2488         'tag_200_indicator1_873510' ,
2489         'tag_200_indicator2_873510' ,
2490         'tag_200_code_a_873510_673465' ,
2491         'tag_200_subfield_a_873510_673465' ,
2492         'tag_200_code_b_873510_704318' ,
2493         'tag_200_subfield_b_873510_704318' ,
2494         'tag_200_code_e_873510_280822' ,
2495         'tag_200_subfield_e_873510_280822' ,
2496         'tag_200_code_f_873510_110730' ,
2497         'tag_200_subfield_f_873510_110730' ,
2498     }
2499     L<$record> is the MARC::Record object.
2500
2501 =cut
2502
2503 sub TransformHtmlToMarc {
2504     my ($cgi, $isbiblio) = @_;
2505
2506     my @params = $cgi->multi_param();
2507
2508     # explicitly turn on the UTF-8 flag for all
2509     # 'tag_' parameters to avoid incorrect character
2510     # conversion later on
2511     my $cgi_params = $cgi->Vars;
2512     foreach my $param_name ( keys %$cgi_params ) {
2513         if ( $param_name =~ /^tag_/ ) {
2514             my $param_value = $cgi_params->{$param_name};
2515             unless ( Encode::is_utf8( $param_value ) ) {
2516                 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2517             }
2518         }
2519     }
2520
2521     # creating a new record
2522     my $record = MARC::Record->new();
2523     my @fields;
2524     my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2525     ($biblionumbertagfield, $biblionumbertagsubfield) =
2526         &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2527 #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!
2528     for (my $i = 0; $params[$i]; $i++ ) {    # browse all CGI params
2529         my $param    = $params[$i];
2530         my $newfield = 0;
2531
2532         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2533         if ( $param eq 'biblionumber' ) {
2534             if ( $biblionumbertagfield < 10 ) {
2535                 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2536             } else {
2537                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2538             }
2539             push @fields, $newfield if ($newfield);
2540         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2541             my $tag = $1;
2542
2543             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2544             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2545             $newfield = 0;
2546             my $j = $i + 2;
2547
2548             if ( $tag < 10 ) {                              # no code for theses fields
2549                                                             # in MARC editor, 000 contains the leader.
2550                 next if $tag == $biblionumbertagfield;
2551                 my $fval= $cgi->param($params[$j+1]);
2552                 if ( $tag eq '000' ) {
2553                     # Force a fake leader even if not provided to avoid crashing
2554                     # during decoding MARC record containing UTF-8 characters
2555                     $record->leader(
2556                         length( $fval ) == 24
2557                         ? $fval
2558                         : '     nam a22        4500'
2559                         )
2560                     ;
2561                     # between 001 and 009 (included)
2562                 } elsif ( $fval ne '' ) {
2563                     $newfield = MARC::Field->new( $tag, $fval, );
2564                 }
2565
2566                 # > 009, deal with subfields
2567             } else {
2568                 # browse subfields for this tag (reason for _code_ match)
2569                 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2570                     last unless defined $params[$j+1];
2571                     $j += 2 and next
2572                         if $tag == $biblionumbertagfield and
2573                            $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2574                     #if next param ne subfield, then it was probably empty
2575                     #try next param by incrementing j
2576                     if($params[$j+1]!~/_subfield_/) {$j++; next; }
2577                     my $fkey= $cgi->param($params[$j]);
2578                     my $fval= $cgi->param($params[$j+1]);
2579                     #check if subfield value not empty and field exists
2580                     if($fval ne '' && $newfield) {
2581                         $newfield->add_subfields( $fkey => $fval);
2582                     }
2583                     elsif($fval ne '') {
2584                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2585                     }
2586                     $j += 2;
2587                 } #end-of-while
2588                 $i= $j-1; #update i for outer loop accordingly
2589             }
2590             push @fields, $newfield if ($newfield);
2591         }
2592     }
2593
2594     $record->append_fields(@fields);
2595     return $record;
2596 }
2597
2598 =head2 TransformMarcToKoha
2599
2600   $result = TransformMarcToKoha( $record, $frameworkcode )
2601
2602 Extract data from a MARC bib record into a hashref representing
2603 Koha biblio, biblioitems, and items fields.
2604
2605 If passed an undefined record will log the error and return an empty
2606 hash_ref
2607
2608 =cut
2609
2610 sub TransformMarcToKoha {
2611     my ( $record, $frameworkcode, $limit_table ) = @_;
2612
2613     my $result = {};
2614     if (!defined $record) {
2615         carp('TransformMarcToKoha called with undefined record');
2616         return $result;
2617     }
2618     $limit_table = $limit_table || 0;
2619     $frameworkcode = '' unless defined $frameworkcode;
2620
2621     my $inverted_field_map = _get_inverted_marc_field_map($frameworkcode);
2622
2623     my %tables = ();
2624     if ( defined $limit_table && $limit_table eq 'items' ) {
2625         $tables{'items'} = 1;
2626     } else {
2627         $tables{'items'}       = 1;
2628         $tables{'biblio'}      = 1;
2629         $tables{'biblioitems'} = 1;
2630     }
2631
2632     # traverse through record
2633   MARCFIELD: foreach my $field ( $record->fields() ) {
2634         my $tag = $field->tag();
2635         next MARCFIELD unless exists $inverted_field_map->{$tag};
2636         if ( $field->is_control_field() ) {
2637             my $kohafields = $inverted_field_map->{$tag}->{list};
2638           ENTRY: foreach my $entry ( @{$kohafields} ) {
2639                 my ( $subfield, $table, $column ) = @{$entry};
2640                 next ENTRY unless exists $tables{$table};
2641                 my $key = _disambiguate( $table, $column );
2642                 if ( $result->{$key} ) {
2643                     unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2644                         $result->{$key} .= " | " . $field->data();
2645                     }
2646                 } else {
2647                     $result->{$key} = $field->data();
2648                 }
2649             }
2650         } else {
2651
2652             # deal with subfields
2653           MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2654                 my $code = $sf->[0];
2655                 next MARCSUBFIELD unless exists $inverted_field_map->{$tag}->{sfs}->{$code};
2656                 my $value = $sf->[1];
2657               SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$tag}->{sfs}->{$code} } ) {
2658                     my ( $table, $column ) = @{$entry};
2659                     next SFENTRY unless exists $tables{$table};
2660                     my $key = _disambiguate( $table, $column );
2661                     if ( $result->{$key} ) {
2662                         unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2663                             $result->{$key} .= " | " . $value;
2664                         }
2665                     } else {
2666                         $result->{$key} = $value;
2667                     }
2668                 }
2669             }
2670         }
2671     }
2672
2673     # modify copyrightdate to keep only the 1st year found
2674     if ( exists $result->{'copyrightdate'} ) {
2675         my $temp = $result->{'copyrightdate'};
2676         $temp =~ m/c(\d\d\d\d)/;
2677         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2678             $result->{'copyrightdate'} = $1;
2679         } else {                                       # if no cYYYY, get the 1st date.
2680             $temp =~ m/(\d\d\d\d)/;
2681             $result->{'copyrightdate'} = $1;
2682         }
2683     }
2684
2685     # modify publicationyear to keep only the 1st year found
2686     if ( exists $result->{'publicationyear'} ) {
2687         my $temp = $result->{'publicationyear'};
2688         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2689             $result->{'publicationyear'} = $1;
2690         } else {                                       # if no cYYYY, get the 1st date.
2691             $temp =~ m/(\d\d\d\d)/;
2692             $result->{'publicationyear'} = $1;
2693         }
2694     }
2695
2696     return $result;
2697 }
2698
2699 sub _get_inverted_marc_field_map {
2700     my ( $frameworkcode ) = @_;
2701     my $field_map = {};
2702     my $mss = GetMarcSubfieldStructure( $frameworkcode );
2703
2704     foreach my $kohafield ( keys %{ $mss } ) {
2705         next unless exists $mss->{$kohafield};    # not all columns are mapped to MARC tag & subfield
2706         my $tag      = $mss->{$kohafield}{tagfield};
2707         my $subfield = $mss->{$kohafield}{tagsubfield};
2708         my ( $table, $column ) = split /[.]/, $kohafield, 2;
2709         push @{ $field_map->{$tag}->{list} }, [ $subfield, $table, $column ];
2710         push @{ $field_map->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2711     }
2712     return $field_map;
2713 }
2714
2715 =head2 _disambiguate
2716
2717   $newkey = _disambiguate($table, $field);
2718
2719 This is a temporary hack to distinguish between the
2720 following sets of columns when using TransformMarcToKoha.
2721
2722   items.cn_source & biblioitems.cn_source
2723   items.cn_sort & biblioitems.cn_sort
2724
2725 Columns that are currently NOT distinguished (FIXME
2726 due to lack of time to fully test) are:
2727
2728   biblio.notes and biblioitems.notes
2729   biblionumber
2730   timestamp
2731   biblioitemnumber
2732
2733 FIXME - this is necessary because prefixing each column
2734 name with the table name would require changing lots
2735 of code and templates, and exposing more of the DB
2736 structure than is good to the UI templates, particularly
2737 since biblio and bibloitems may well merge in a future
2738 version.  In the future, it would also be good to
2739 separate DB access and UI presentation field names
2740 more.
2741
2742 =cut
2743
2744 sub CountItemsIssued {
2745     my ($biblionumber) = @_;
2746     my $dbh            = C4::Context->dbh;
2747     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2748     $sth->execute($biblionumber);
2749     my $row = $sth->fetchrow_hashref();
2750     return $row->{'issuedCount'};
2751 }
2752
2753 sub _disambiguate {
2754     my ( $table, $column ) = @_;
2755     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2756         return $table . '.' . $column;
2757     } else {
2758         return $column;
2759     }
2760
2761 }
2762
2763 =head2 get_koha_field_from_marc
2764
2765   $result->{_disambiguate($table, $field)} =
2766      get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2767
2768 Internal function to map data from the MARC record to a specific non-MARC field.
2769 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2770
2771 =cut
2772
2773 sub get_koha_field_from_marc {
2774     my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2775     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2776     my $kohafield;
2777     foreach my $field ( $record->field($tagfield) ) {
2778         if ( $field->tag() < 10 ) {
2779             if ($kohafield) {
2780                 $kohafield .= " | " . $field->data();
2781             } else {
2782                 $kohafield = $field->data();
2783             }
2784         } else {
2785             if ( $field->subfields ) {
2786                 my @subfields = $field->subfields();
2787                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2788                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2789                         if ($kohafield) {
2790                             $kohafield .= " | " . $subfields[$subfieldcount][1];
2791                         } else {
2792                             $kohafield = $subfields[$subfieldcount][1];
2793                         }
2794                     }
2795                 }
2796             }
2797         }
2798     }
2799     return $kohafield;
2800 }
2801
2802 =head2 TransformMarcToKohaOneField
2803
2804   $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2805
2806 =cut
2807
2808 sub TransformMarcToKohaOneField {
2809
2810     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2811     # only the 1st will be retrieved...
2812     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2813     my $res = "";
2814     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2815     foreach my $field ( $record->field($tagfield) ) {
2816         if ( $field->tag() < 10 ) {
2817             if ( $result->{$kohafield} ) {
2818                 $result->{$kohafield} .= " | " . $field->data();
2819             } else {
2820                 $result->{$kohafield} = $field->data();
2821             }
2822         } else {
2823             if ( $field->subfields ) {
2824                 my @subfields = $field->subfields();
2825                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2826                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2827                         if ( $result->{$kohafield} ) {
2828                             $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2829                         } else {
2830                             $result->{$kohafield} = $subfields[$subfieldcount][1];
2831                         }
2832                     }
2833                 }
2834             }
2835         }
2836     }
2837     return $result;
2838 }
2839
2840
2841 #"
2842
2843 #
2844 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2845 # at the same time
2846 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2847 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2848 # =head2 ModZebrafiles
2849 #
2850 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2851 #
2852 # =cut
2853 #
2854 # sub ModZebrafiles {
2855 #
2856 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2857 #
2858 #     my $op;
2859 #     my $zebradir =
2860 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2861 #     unless ( opendir( DIR, "$zebradir" ) ) {
2862 #         warn "$zebradir not found";
2863 #         return;
2864 #     }
2865 #     closedir DIR;
2866 #     my $filename = $zebradir . $biblionumber;
2867 #
2868 #     if ($record) {
2869 #         open( OUTPUT, ">", $filename . ".xml" );
2870 #         print OUTPUT $record;
2871 #         close OUTPUT;
2872 #     }
2873 # }
2874
2875 =head2 ModZebra
2876
2877   ModZebra( $biblionumber, $op, $server, $record );
2878
2879 $biblionumber is the biblionumber we want to index
2880
2881 $op is specialUpdate or recordDelete, and is used to know what we want to do
2882
2883 $server is the server that we want to update
2884
2885 $record is the update MARC record if it's available. If it's not supplied
2886 and is needed, it'll be loaded from the database.
2887
2888 =cut
2889
2890 sub ModZebra {
2891 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2892     my ( $biblionumber, $op, $server, $record ) = @_;
2893     $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2894     if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
2895
2896         # TODO abstract to a standard API that'll work for whatever
2897         require Koha::SearchEngine::Elasticsearch::Indexer;
2898         my $indexer = Koha::SearchEngine::Elasticsearch::Indexer->new(
2899             {
2900                 index => $server eq 'biblioserver'
2901                 ? $Koha::SearchEngine::BIBLIOS_INDEX
2902                 : $Koha::SearchEngine::AUTHORITIES_INDEX
2903             }
2904         );
2905         if ( $op eq 'specialUpdate' ) {
2906             unless ($record) {
2907                 $record = GetMarcBiblio($biblionumber, 1);
2908             }
2909             my $records = [$record];
2910             $indexer->update_index_background( [$biblionumber], [$record] );
2911         }
2912         elsif ( $op eq 'recordDelete' ) {
2913             $indexer->delete_index_background( [$biblionumber] );
2914         }
2915         else {
2916             croak "ModZebra called with unknown operation: $op";
2917         }
2918     }
2919
2920     my $dbh = C4::Context->dbh;
2921
2922     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2923     # at the same time
2924     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2925     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2926     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2927     WHERE server = ?
2928         AND   biblio_auth_number = ?
2929         AND   operation = ?
2930         AND   done = 0";
2931     my $check_sth = $dbh->prepare_cached($check_sql);
2932     $check_sth->execute( $server, $biblionumber, $op );
2933     my ($count) = $check_sth->fetchrow_array;
2934     $check_sth->finish();
2935     if ( $count == 0 ) {
2936         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2937         $sth->execute( $biblionumber, $server, $op );
2938         $sth->finish;
2939     }
2940 }
2941
2942
2943 =head2 EmbedItemsInMarcBiblio
2944
2945     EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers, $opac);
2946
2947 Given a MARC::Record object containing a bib record,
2948 modify it to include the items attached to it as 9XX
2949 per the bib's MARC framework.
2950 if $itemnumbers is defined, only specified itemnumbers are embedded.
2951
2952 If $opac is true, then opac-relevant suppressions are included.
2953
2954 =cut
2955
2956 sub EmbedItemsInMarcBiblio {
2957     my ($marc, $biblionumber, $itemnumbers, $opac) = @_;
2958     if ( !$marc ) {
2959         carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2960         return;
2961     }
2962
2963     $itemnumbers = [] unless defined $itemnumbers;
2964
2965     my $frameworkcode = GetFrameworkCode($biblionumber);
2966     _strip_item_fields($marc, $frameworkcode);
2967
2968     # ... and embed the current items
2969     my $dbh = C4::Context->dbh;
2970     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2971     $sth->execute($biblionumber);
2972     my @item_fields;
2973     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2974     my @items;
2975     my $opachiddenitems = $opac
2976       && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2977     require C4::Items;
2978     while ( my ($itemnumber) = $sth->fetchrow_array ) {
2979         next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2980         my $i = $opachiddenitems ? C4::Items::GetItem($itemnumber) : undef;
2981         push @items, { itemnumber => $itemnumber, item => $i };
2982     }
2983     my @hiddenitems =
2984       $opachiddenitems
2985       ? C4::Items::GetHiddenItemnumbers( map { $_->{item} } @items )
2986       : ();
2987     # Convert to a hash for quick searching
2988     my %hiddenitems = map { $_ => 1 } @hiddenitems;
2989     foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2990         next if $hiddenitems{$itemnumber};
2991         my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2992         push @item_fields, $item_marc->field($itemtag);
2993     }
2994     $marc->append_fields(@item_fields);
2995 }
2996
2997 =head1 INTERNAL FUNCTIONS
2998
2999 =head2 _koha_marc_update_bib_ids
3000
3001
3002   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3003
3004 Internal function to add or update biblionumber and biblioitemnumber to
3005 the MARC XML.
3006
3007 =cut
3008
3009 sub _koha_marc_update_bib_ids {
3010     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3011
3012     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
3013     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
3014     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3015     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
3016
3017     if ( $biblio_tag < 10 ) {
3018         C4::Biblio::UpsertMarcControlField( $record, $biblio_tag, $biblionumber );
3019     } else {
3020         C4::Biblio::UpsertMarcSubfield($record, $biblio_tag, $biblio_subfield, $biblionumber);
3021     }
3022     if ( $biblioitem_tag < 10 ) {
3023         C4::Biblio::UpsertMarcControlField( $record, $biblioitem_tag, $biblioitemnumber );
3024     } else {
3025         C4::Biblio::UpsertMarcSubfield($record, $biblioitem_tag, $biblioitem_subfield, $biblioitemnumber);
3026     }
3027 }
3028
3029 =head2 _koha_marc_update_biblioitem_cn_sort
3030
3031   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3032
3033 Given a MARC bib record and the biblioitem hash, update the
3034 subfield that contains a copy of the value of biblioitems.cn_sort.
3035
3036 =cut
3037
3038 sub _koha_marc_update_biblioitem_cn_sort {
3039     my $marc          = shift;
3040     my $biblioitem    = shift;
3041     my $frameworkcode = shift;
3042
3043     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3044     return unless $biblioitem_tag;
3045
3046     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3047
3048     if ( my $field = $marc->field($biblioitem_tag) ) {
3049         $field->delete_subfield( code => $biblioitem_subfield );
3050         if ( $cn_sort ne '' ) {
3051             $field->add_subfields( $biblioitem_subfield => $cn_sort );
3052         }
3053     } else {
3054
3055         # if we get here, no biblioitem tag is present in the MARC record, so
3056         # we'll create it if $cn_sort is not empty -- this would be
3057         # an odd combination of events, however
3058         if ($cn_sort) {
3059             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3060         }
3061     }
3062 }
3063
3064 =head2 _koha_add_biblio
3065
3066   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3067
3068 Internal function to add a biblio ($biblio is a hash with the values)
3069
3070 =cut
3071
3072 sub _koha_add_biblio {
3073     my ( $dbh, $biblio, $frameworkcode ) = @_;
3074
3075     my $error;
3076
3077     # set the series flag
3078     unless (defined $biblio->{'serial'}){
3079         $biblio->{'serial'} = 0;
3080         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3081     }
3082
3083     my $query = "INSERT INTO biblio
3084         SET frameworkcode = ?,
3085             author = ?,
3086             title = ?,
3087             unititle =?,
3088             notes = ?,
3089             serial = ?,
3090             seriestitle = ?,
3091             copyrightdate = ?,
3092             datecreated=NOW(),
3093             abstract = ?
3094         ";
3095     my $sth = $dbh->prepare($query);
3096     $sth->execute(
3097         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3098         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3099     );
3100
3101     my $biblionumber = $dbh->{'mysql_insertid'};
3102     if ( $dbh->errstr ) {
3103         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3104         warn $error;
3105     }
3106
3107     $sth->finish();
3108
3109     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3110     return ( $biblionumber, $error );
3111 }
3112
3113 =head2 _koha_modify_biblio
3114
3115   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3116
3117 Internal function for updating the biblio table
3118
3119 =cut
3120
3121 sub _koha_modify_biblio {
3122     my ( $dbh, $biblio, $frameworkcode ) = @_;
3123     my $error;
3124
3125     my $query = "
3126         UPDATE biblio
3127         SET    frameworkcode = ?,
3128                author = ?,
3129                title = ?,
3130                unititle = ?,
3131                notes = ?,
3132                serial = ?,
3133                seriestitle = ?,
3134                copyrightdate = ?,
3135                abstract = ?
3136         WHERE  biblionumber = ?
3137         "
3138       ;
3139     my $sth = $dbh->prepare($query);
3140
3141     $sth->execute(
3142         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3143         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3144     ) if $biblio->{'biblionumber'};
3145
3146     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3147         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3148         warn $error;
3149     }
3150     return ( $biblio->{'biblionumber'}, $error );
3151 }
3152
3153 =head2 _koha_modify_biblioitem_nonmarc
3154
3155   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3156
3157 =cut
3158
3159 sub _koha_modify_biblioitem_nonmarc {
3160     my ( $dbh, $biblioitem ) = @_;
3161     my $error;
3162
3163     # re-calculate the cn_sort, it may have changed
3164     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3165
3166     my $query = "UPDATE biblioitems
3167     SET biblionumber    = ?,
3168         volume          = ?,
3169         number          = ?,
3170         itemtype        = ?,
3171         isbn            = ?,
3172         issn            = ?,
3173         publicationyear = ?,
3174         publishercode   = ?,
3175         volumedate      = ?,
3176         volumedesc      = ?,
3177         collectiontitle = ?,
3178         collectionissn  = ?,
3179         collectionvolume= ?,
3180         editionstatement= ?,
3181         editionresponsibility = ?,
3182         illus           = ?,
3183         pages           = ?,
3184         notes           = ?,
3185         size            = ?,
3186         place           = ?,
3187         lccn            = ?,
3188         url             = ?,
3189         cn_source       = ?,
3190         cn_class        = ?,
3191         cn_item         = ?,
3192         cn_suffix       = ?,
3193         cn_sort         = ?,
3194         totalissues     = ?,
3195         ean             = ?,
3196         agerestriction  = ?
3197         where biblioitemnumber = ?
3198         ";
3199     my $sth = $dbh->prepare($query);
3200     $sth->execute(
3201         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3202         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3203         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3204         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3205         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3206         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3207         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3208         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
3209     );
3210     if ( $dbh->errstr ) {
3211         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3212         warn $error;
3213     }
3214     return ( $biblioitem->{'biblioitemnumber'}, $error );
3215 }
3216
3217 =head2 _koha_add_biblioitem
3218
3219   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3220
3221 Internal function to add a biblioitem
3222
3223 =cut
3224
3225 sub _koha_add_biblioitem {
3226     my ( $dbh, $biblioitem ) = @_;
3227     my $error;
3228
3229     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3230     my $query = "INSERT INTO biblioitems SET
3231         biblionumber    = ?,
3232         volume          = ?,
3233         number          = ?,
3234         itemtype        = ?,
3235         isbn            = ?,
3236         issn            = ?,
3237         publicationyear = ?,
3238         publishercode   = ?,
3239         volumedate      = ?,
3240         volumedesc      = ?,
3241         collectiontitle = ?,
3242         collectionissn  = ?,
3243         collectionvolume= ?,
3244         editionstatement= ?,
3245         editionresponsibility = ?,
3246         illus           = ?,
3247         pages           = ?,
3248         notes           = ?,
3249         size            = ?,
3250         place           = ?,
3251         lccn            = ?,
3252         url             = ?,
3253         cn_source       = ?,
3254         cn_class        = ?,
3255         cn_item         = ?,
3256         cn_suffix       = ?,
3257         cn_sort         = ?,
3258         totalissues     = ?,
3259         ean             = ?,
3260         agerestriction  = ?
3261         ";
3262     my $sth = $dbh->prepare($query);
3263     $sth->execute(
3264         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3265         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3266         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3267         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3268         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3269         $biblioitem->{'lccn'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3270         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3271         $biblioitem->{'totalissues'},      $biblioitem->{'ean'},              $biblioitem->{'agerestriction'}
3272     );
3273     my $bibitemnum = $dbh->{'mysql_insertid'};
3274
3275     if ( $dbh->errstr ) {
3276         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3277         warn $error;
3278     }
3279     $sth->finish();
3280     return ( $bibitemnum, $error );
3281 }
3282
3283 =head2 _koha_delete_biblio
3284
3285   $error = _koha_delete_biblio($dbh,$biblionumber);
3286
3287 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3288
3289 C<$dbh> - the database handle
3290
3291 C<$biblionumber> - the biblionumber of the biblio to be deleted
3292
3293 =cut
3294
3295 # FIXME: add error handling
3296
3297 sub _koha_delete_biblio {
3298     my ( $dbh, $biblionumber ) = @_;
3299
3300     # get all the data for this biblio
3301     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3302     $sth->execute($biblionumber);
3303
3304     # FIXME There is a transaction in _koha_delete_biblio_metadata
3305     # But actually all the following should be done inside a single transaction
3306     if ( my $data = $sth->fetchrow_hashref ) {
3307
3308         # save the record in deletedbiblio
3309         # find the fields to save
3310         my $query = "INSERT INTO deletedbiblio SET ";
3311         my @bind  = ();
3312         foreach my $temp ( keys %$data ) {
3313             $query .= "$temp = ?,";
3314             push( @bind, $data->{$temp} );
3315         }
3316
3317         # replace the last , by ",?)"
3318         $query =~ s/\,$//;
3319         my $bkup_sth = $dbh->prepare($query);
3320         $bkup_sth->execute(@bind);
3321         $bkup_sth->finish;
3322
3323         _koha_delete_biblio_metadata( $biblionumber );
3324
3325         # delete the biblio
3326         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3327         $sth2->execute($biblionumber);
3328         # update the timestamp (Bugzilla 7146)
3329         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3330         $sth2->execute($biblionumber);
3331         $sth2->finish;
3332     }
3333     $sth->finish;
3334     return;
3335 }
3336
3337 =head2 _koha_delete_biblioitems
3338
3339   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3340
3341 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3342
3343 C<$dbh> - the database handle
3344 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3345
3346 =cut
3347
3348 # FIXME: add error handling
3349
3350 sub _koha_delete_biblioitems {
3351     my ( $dbh, $biblioitemnumber ) = @_;
3352
3353     # get all the data for this biblioitem
3354     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3355     $sth->execute($biblioitemnumber);
3356
3357     if ( my $data = $sth->fetchrow_hashref ) {
3358
3359         # save the record in deletedbiblioitems
3360         # find the fields to save
3361         my $query = "INSERT INTO deletedbiblioitems SET ";
3362         my @bind  = ();
3363         foreach my $temp ( keys %$data ) {
3364             $query .= "$temp = ?,";
3365             push( @bind, $data->{$temp} );
3366         }
3367
3368         # replace the last , by ",?)"
3369         $query =~ s/\,$//;
3370         my $bkup_sth = $dbh->prepare($query);
3371         $bkup_sth->execute(@bind);
3372         $bkup_sth->finish;
3373
3374         # delete the biblioitem
3375         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3376         $sth2->execute($biblioitemnumber);
3377         # update the timestamp (Bugzilla 7146)
3378         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3379         $sth2->execute($biblioitemnumber);
3380         $sth2->finish;
3381     }
3382     $sth->finish;
3383     return;
3384 }
3385
3386 =head2 _koha_delete_biblio_metadata
3387
3388   $error = _koha_delete_biblio_metadata($biblionumber);
3389
3390 C<$biblionumber> - the biblionumber of the biblio metadata to be deleted
3391
3392 =cut
3393
3394 sub _koha_delete_biblio_metadata {
3395     my ($biblionumber) = @_;
3396
3397     my $dbh    = C4::Context->dbh;
3398     my $schema = Koha::Database->new->schema;
3399     $schema->txn_do(
3400         sub {
3401             $dbh->do( q|
3402                 INSERT INTO deletedbiblio_metadata (biblionumber, format, marcflavour, metadata)
3403                 SELECT biblionumber, format, marcflavour, metadata FROM biblio_metadata WHERE biblionumber=?
3404             |,  undef, $biblionumber );
3405             $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|,
3406                 undef, $biblionumber );
3407         }
3408     );
3409 }
3410
3411 =head1 UNEXPORTED FUNCTIONS
3412
3413 =head2 ModBiblioMarc
3414
3415   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3416
3417 Add MARC XML data for a biblio to koha
3418
3419 Function exported, but should NOT be used, unless you really know what you're doing
3420
3421 =cut
3422
3423 sub ModBiblioMarc {
3424     # pass the MARC::Record to this function, and it will create the records in
3425     # the marcxml field
3426     my ( $record, $biblionumber, $frameworkcode ) = @_;
3427     if ( !$record ) {
3428         carp 'ModBiblioMarc passed an undefined record';
3429         return;
3430     }
3431
3432     # Clone record as it gets modified
3433     $record = $record->clone();
3434     my $dbh    = C4::Context->dbh;
3435     my @fields = $record->fields();
3436     if ( !$frameworkcode ) {
3437         $frameworkcode = "";
3438     }
3439     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3440     $sth->execute( $frameworkcode, $biblionumber );
3441     $sth->finish;
3442     my $encoding = C4::Context->preference("marcflavour");
3443
3444     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3445     if ( $encoding eq "UNIMARC" ) {
3446         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3447         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3448         my $string = $record->subfield( 100, "a" );
3449         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3450             my $f100 = $record->field(100);
3451             $record->delete_field($f100);
3452         } else {
3453             $string = POSIX::strftime( "%Y%m%d", localtime );
3454             $string =~ s/\-//g;
3455             $string = sprintf( "%-*s", 35, $string );
3456             substr ( $string, 22, 3, $defaultlanguage);
3457         }
3458         substr( $string, 25, 3, "y50" );
3459         unless ( $record->subfield( 100, "a" ) ) {
3460             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3461         }
3462     }
3463
3464     #enhancement 5374: update transaction date (005) for marc21/unimarc
3465     if($encoding =~ /MARC21|UNIMARC/) {
3466       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3467         # YY MM DD HH MM SS (update year and month)
3468       my $f005= $record->field('005');
3469       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3470     }
3471
3472     my $metadata = {
3473         biblionumber => $biblionumber,
3474         format       => 'marcxml',
3475         marcflavour  => C4::Context->preference('marcflavour'),
3476     };
3477     # FIXME To replace with ->find_or_create?
3478     if ( my $m_rs = Koha::Biblio::Metadatas->find($metadata) ) {
3479         $m_rs->metadata( $record->as_xml_record($encoding) );
3480         $m_rs->store;
3481     } else {
3482         my $m_rs = Koha::Biblio::Metadata->new($metadata);
3483         $m_rs->metadata( $record->as_xml_record($encoding) );
3484         $m_rs->store;
3485     }
3486     ModZebra( $biblionumber, "specialUpdate", "biblioserver", $record );
3487     return $biblionumber;
3488 }
3489
3490 =head2 CountBiblioInOrders
3491
3492     $count = &CountBiblioInOrders( $biblionumber);
3493
3494 This function return count of biblios in orders with $biblionumber
3495
3496 =cut
3497
3498 sub CountBiblioInOrders {
3499  my ($biblionumber) = @_;
3500     my $dbh            = C4::Context->dbh;
3501     my $query          = "SELECT count(*)
3502           FROM  aqorders
3503           WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3504     my $sth = $dbh->prepare($query);
3505     $sth->execute($biblionumber);
3506     my $count = $sth->fetchrow;
3507     return ($count);
3508 }
3509
3510 =head2 GetSubscriptionsId
3511
3512     $subscriptions = &GetSubscriptionsId($biblionumber);
3513
3514 This function return an array of subscriptionid with $biblionumber
3515
3516 =cut
3517
3518 sub GetSubscriptionsId {
3519  my ($biblionumber) = @_;
3520     my $dbh            = C4::Context->dbh;
3521     my $query          = "SELECT subscriptionid
3522           FROM  subscription
3523           WHERE biblionumber=?";
3524     my $sth = $dbh->prepare($query);
3525     $sth->execute($biblionumber);
3526     my @subscriptions = $sth->fetchrow_array;
3527     return (@subscriptions);
3528 }
3529
3530 =head2 prepare_host_field
3531
3532 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3533 Generate the host item entry for an analytic child entry
3534
3535 =cut
3536
3537 sub prepare_host_field {
3538     my ( $hostbiblio, $marcflavour ) = @_;
3539     $marcflavour ||= C4::Context->preference('marcflavour');
3540     my $host = GetMarcBiblio($hostbiblio);
3541     # unfortunately as_string does not 'do the right thing'
3542     # if field returns undef
3543     my %sfd;
3544     my $field;
3545     my $host_field;
3546     if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3547         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3548             my $s = $field->as_string('ab');
3549             if ($s) {
3550                 $sfd{a} = $s;
3551             }
3552         }
3553         if ( $field = $host->field('245') ) {
3554             my $s = $field->as_string('a');
3555             if ($s) {
3556                 $sfd{t} = $s;
3557             }
3558         }
3559         if ( $field = $host->field('260') ) {
3560             my $s = $field->as_string('abc');
3561             if ($s) {
3562                 $sfd{d} = $s;
3563             }
3564         }
3565         if ( $field = $host->field('240') ) {
3566             my $s = $field->as_string();
3567             if ($s) {
3568                 $sfd{b} = $s;
3569             }
3570         }
3571         if ( $field = $host->field('022') ) {
3572             my $s = $field->as_string('a');
3573             if ($s) {
3574                 $sfd{x} = $s;
3575             }
3576         }
3577         if ( $field = $host->field('020') ) {
3578             my $s = $field->as_string('a');
3579             if ($s) {
3580                 $sfd{z} = $s;
3581             }
3582         }
3583         if ( $field = $host->field('001') ) {
3584             $sfd{w} = $field->data(),;
3585         }
3586         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3587         return $host_field;
3588     }
3589     elsif ( $marcflavour eq 'UNIMARC' ) {
3590         #author
3591         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3592             my $s = $field->as_string('ab');
3593             if ($s) {
3594                 $sfd{a} = $s;
3595             }
3596         }
3597         #title
3598         if ( $field = $host->field('200') ) {
3599             my $s = $field->as_string('a');
3600             if ($s) {
3601                 $sfd{t} = $s;
3602             }
3603         }
3604         #place of publicaton
3605         if ( $field = $host->field('210') ) {
3606             my $s = $field->as_string('a');
3607             if ($s) {
3608                 $sfd{c} = $s;
3609             }
3610         }
3611         #date of publication
3612         if ( $field = $host->field('210') ) {
3613             my $s = $field->as_string('d');
3614             if ($s) {
3615                 $sfd{d} = $s;
3616             }
3617         }
3618         #edition statement
3619         if ( $field = $host->field('205') ) {
3620             my $s = $field->as_string();
3621             if ($s) {
3622                 $sfd{e} = $s;
3623             }
3624         }
3625         #URL
3626         if ( $field = $host->field('856') ) {
3627             my $s = $field->as_string('u');
3628             if ($s) {
3629                 $sfd{u} = $s;
3630             }
3631         }
3632         #ISSN
3633         if ( $field = $host->field('011') ) {
3634             my $s = $field->as_string('a');
3635             if ($s) {
3636                 $sfd{x} = $s;
3637             }
3638         }
3639         #ISBN
3640         if ( $field = $host->field('010') ) {
3641             my $s = $field->as_string('a');
3642             if ($s) {
3643                 $sfd{y} = $s;
3644             }
3645         }
3646         if ( $field = $host->field('001') ) {
3647             $sfd{0} = $field->data(),;
3648         }
3649         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3650         return $host_field;
3651     }
3652     return;
3653 }
3654
3655
3656 =head2 UpdateTotalIssues
3657
3658   UpdateTotalIssues($biblionumber, $increase, [$value])
3659
3660 Update the total issue count for a particular bib record.
3661
3662 =over 4
3663
3664 =item C<$biblionumber> is the biblionumber of the bib to update
3665
3666 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3667
3668 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3669
3670 =back
3671
3672 =cut
3673
3674 sub UpdateTotalIssues {
3675     my ($biblionumber, $increase, $value) = @_;
3676     my $totalissues;
3677
3678     my $record = GetMarcBiblio($biblionumber);
3679     unless ($record) {
3680         carp "UpdateTotalIssues could not get biblio record";
3681         return;
3682     }
3683     my $data = GetBiblioData($biblionumber);
3684     unless ($data) {
3685         carp "UpdateTotalIssues could not get datas of biblio";
3686         return;
3687     }
3688     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
3689     unless ($totalissuestag) {
3690         return 1; # There is nothing to do
3691     }
3692
3693     if (defined $value) {
3694         $totalissues = $value;
3695     } else {
3696         $totalissues = $data->{'totalissues'} + $increase;
3697     }
3698
3699      my $field = $record->field($totalissuestag);
3700      if (defined $field) {
3701          $field->update( $totalissuessubfield => $totalissues );
3702      } else {
3703          $field = MARC::Field->new($totalissuestag, '0', '0',
3704                  $totalissuessubfield => $totalissues);
3705          $record->insert_grouped_field($field);
3706      }
3707
3708      return ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
3709 }
3710
3711 =head2 RemoveAllNsb
3712
3713     &RemoveAllNsb($record);
3714
3715 Removes all nsb/nse chars from a record
3716
3717 =cut
3718
3719 sub RemoveAllNsb {
3720     my $record = shift;
3721     if (!$record) {
3722         carp 'RemoveAllNsb called with undefined record';
3723         return;
3724     }
3725
3726     SetUTF8Flag($record);
3727
3728     foreach my $field ($record->fields()) {
3729         if ($field->is_control_field()) {
3730             $field->update(nsb_clean($field->data()));
3731         } else {
3732             my @subfields = $field->subfields();
3733             my @new_subfields;
3734             foreach my $subfield (@subfields) {
3735                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3736             }
3737             if (scalar(@new_subfields) > 0) {
3738                 my $new_field;
3739                 eval {
3740                     $new_field = MARC::Field->new(
3741                         $field->tag(),
3742                         $field->indicator(1),
3743                         $field->indicator(2),
3744                         @new_subfields
3745                     );
3746                 };
3747                 if ($@) {
3748                     warn "error in RemoveAllNsb : $@";
3749                 } else {
3750                     $field->replace_with($new_field);
3751                 }
3752             }
3753         }
3754     }
3755
3756     return $record;
3757 }
3758
3759 1;
3760
3761
3762 __END__
3763
3764 =head1 AUTHOR
3765
3766 Koha Development Team <http://koha-community.org/>
3767
3768 Paul POULAIN paul.poulain@free.fr
3769
3770 Joshua Ferraro jmf@liblime.com
3771
3772 =cut