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