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