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