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