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 );
 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);
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
1126 =cut
1127
1128 sub GetMarcStructure {
1129     my ( $forlibrarian, $frameworkcode ) = @_;
1130     $frameworkcode = "" unless $frameworkcode;
1131
1132     $forlibrarian = $forlibrarian ? 1 : 0;
1133     my $cache = Koha::Caches->get_instance();
1134     my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
1135     my $cached = $cache->get_from_cache($cache_key);
1136     return $cached if $cached;
1137
1138     my $dbh = C4::Context->dbh;
1139     my $sth = $dbh->prepare(
1140         "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1141         FROM marc_tag_structure
1142         WHERE frameworkcode=?
1143         ORDER BY tagfield"
1144     );
1145     $sth->execute($frameworkcode);
1146     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1147
1148     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
1149         $res->{$tag}->{lib}        = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1150         $res->{$tag}->{tab}        = "";
1151         $res->{$tag}->{mandatory}  = $mandatory;
1152         $res->{$tag}->{repeatable} = $repeatable;
1153     }
1154
1155     $sth = $dbh->prepare(
1156         "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue,maxlength
1157          FROM   marc_subfield_structure
1158          WHERE  frameworkcode=?
1159          ORDER BY tagfield,tagsubfield
1160         "
1161     );
1162
1163     $sth->execute($frameworkcode);
1164
1165     my $subfield;
1166     my $authorised_value;
1167     my $authtypecode;
1168     my $value_builder;
1169     my $kohafield;
1170     my $seealso;
1171     my $hidden;
1172     my $isurl;
1173     my $link;
1174     my $defaultvalue;
1175     my $maxlength;
1176
1177     while (
1178         (   $tag,          $subfield,      $liblibrarian, $libopac, $tab,    $mandatory, $repeatable, $authorised_value,
1179             $authtypecode, $value_builder, $kohafield,    $seealso, $hidden, $isurl,     $link,       $defaultvalue,
1180             $maxlength
1181         )
1182         = $sth->fetchrow
1183       ) {
1184         $res->{$tag}->{$subfield}->{lib}              = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1185         $res->{$tag}->{$subfield}->{tab}              = $tab;
1186         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1187         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1188         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1189         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1190         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1191         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1192         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1193         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1194         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1195         $res->{$tag}->{$subfield}->{'link'}           = $link;
1196         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
1197         $res->{$tag}->{$subfield}->{maxlength}        = $maxlength;
1198     }
1199
1200     $cache->set_in_cache($cache_key, $res);
1201     return $res;
1202 }
1203
1204 =head2 GetUsedMarcStructure
1205
1206 The same function as GetMarcStructure except it just takes field
1207 in tab 0-9. (used field)
1208
1209   my $results = GetUsedMarcStructure($frameworkcode);
1210
1211 C<$results> is a ref to an array which each case containts a ref
1212 to a hash which each keys is the columns from marc_subfield_structure
1213
1214 C<$frameworkcode> is the framework code.
1215
1216 =cut
1217
1218 sub GetUsedMarcStructure {
1219     my $frameworkcode = shift || '';
1220     my $query = q{
1221         SELECT *
1222         FROM   marc_subfield_structure
1223         WHERE   tab > -1
1224             AND frameworkcode = ?
1225         ORDER BY tagfield, tagsubfield
1226     };
1227     my $sth = C4::Context->dbh->prepare($query);
1228     $sth->execute($frameworkcode);
1229     return $sth->fetchall_arrayref( {} );
1230 }
1231
1232 =head2 GetMarcSubfieldStructure
1233
1234 =cut
1235
1236 sub GetMarcSubfieldStructure {
1237     my ( $frameworkcode ) = @_;
1238
1239     $frameworkcode //= '';
1240
1241     my $cache     = Koha::Caches->get_instance();
1242     my $cache_key = "MarcSubfieldStructure-$frameworkcode";
1243     my $cached    = $cache->get_from_cache($cache_key);
1244     return $cached if $cached;
1245
1246     my $dbh = C4::Context->dbh;
1247     my $subfield_structure = $dbh->selectall_hashref( q|
1248         SELECT *
1249         FROM marc_subfield_structure
1250         WHERE frameworkcode = ?
1251         AND kohafield > ''
1252     |, 'kohafield', {}, $frameworkcode );
1253
1254     $cache->set_in_cache( $cache_key, $subfield_structure );
1255     return $subfield_structure;
1256 }
1257
1258 =head2 GetMarcFromKohaField
1259
1260   ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1261
1262 Returns the MARC fields & subfields mapped to the koha field
1263 for the given frameworkcode or default framework if $frameworkcode is missing
1264
1265 =cut
1266
1267 sub GetMarcFromKohaField {
1268     my ( $kohafield, $frameworkcode ) = @_;
1269     return (0, undef) unless $kohafield;
1270     my $mss = GetMarcSubfieldStructure( $frameworkcode );
1271     return ( $mss->{$kohafield}{tagfield}, $mss->{$kohafield}{tagsubfield} );
1272 }
1273
1274 =head2 GetMarcSubfieldStructureFromKohaField
1275
1276     my $subfield_structure = &GetMarcSubfieldStructureFromKohaField($kohafield, $frameworkcode);
1277
1278 Returns a hashref where keys are marc_subfield_structure column names for the
1279 row where kohafield=$kohafield for the given framework code.
1280
1281 $frameworkcode is optional. If not given, then the default framework is used.
1282
1283 =cut
1284
1285 sub GetMarcSubfieldStructureFromKohaField {
1286     my ( $kohafield, $frameworkcode ) = @_;
1287
1288     return unless $kohafield;
1289
1290     my $mss = GetMarcSubfieldStructure( $frameworkcode );
1291     return exists $mss->{$kohafield}
1292         ? $mss->{$kohafield}
1293         : undef;
1294 }
1295
1296 =head2 GetMarcBiblio
1297
1298   my $record = GetMarcBiblio($biblionumber, [$embeditems], [$opac]);
1299
1300 Returns MARC::Record representing a biblio record, or C<undef> if the
1301 biblionumber doesn't exist.
1302
1303 =over 4
1304
1305 =item C<$biblionumber>
1306
1307 the biblionumber
1308
1309 =item C<$embeditems>
1310
1311 set to true to include item information.
1312
1313 =item C<$opac>
1314
1315 set to true to make the result suited for OPAC view. This causes things like
1316 OpacHiddenItems to be applied.
1317
1318 =back
1319
1320 =cut
1321
1322 sub GetMarcBiblio {
1323     my $biblionumber = shift;
1324     my $embeditems   = shift || 0;
1325     my $opac         = shift || 0;
1326
1327     if (not defined $biblionumber) {
1328         carp 'GetMarcBiblio called with undefined biblionumber';
1329         return;
1330     }
1331
1332     my $dbh          = C4::Context->dbh;
1333     my $sth          = $dbh->prepare("SELECT biblioitemnumber, marcxml FROM biblioitems WHERE biblionumber=? ");
1334     $sth->execute($biblionumber);
1335     my $row     = $sth->fetchrow_hashref;
1336     my $biblioitemnumber = $row->{'biblioitemnumber'};
1337     my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
1338     my $frameworkcode = GetFrameworkCode($biblionumber);
1339     MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1340     my $record = MARC::Record->new();
1341
1342     if ($marcxml) {
1343         $record = eval {
1344             MARC::Record::new_from_xml( $marcxml, "utf8",
1345                 C4::Context->preference('marcflavour') );
1346         };
1347         if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1348         return unless $record;
1349
1350         C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber,
1351             $biblioitemnumber );
1352         C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblionumber, undef, $opac )
1353           if ($embeditems);
1354
1355         return $record;
1356     }
1357     else {
1358         return;
1359     }
1360 }
1361
1362 =head2 GetXmlBiblio
1363
1364   my $marcxml = GetXmlBiblio($biblionumber);
1365
1366 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1367 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1368
1369 =cut
1370
1371 sub GetXmlBiblio {
1372     my ($biblionumber) = @_;
1373     my $dbh            = C4::Context->dbh;
1374     my $sth            = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1375     $sth->execute($biblionumber);
1376     my ($marcxml) = $sth->fetchrow;
1377     return $marcxml;
1378 }
1379
1380 =head2 GetCOinSBiblio
1381
1382   my $coins = GetCOinSBiblio($record);
1383
1384 Returns the COinS (a span) which can be included in a biblio record
1385
1386 =cut
1387
1388 sub GetCOinSBiblio {
1389     my $record = shift;
1390
1391     # get the coin format
1392     if ( ! $record ) {
1393         carp 'GetCOinSBiblio called with undefined record';
1394         return;
1395     }
1396     my $pos7 = substr $record->leader(), 7, 1;
1397     my $pos6 = substr $record->leader(), 6, 1;
1398     my $mtx;
1399     my $genre;
1400     my ( $aulast, $aufirst ) = ( '', '' );
1401     my $oauthors  = '';
1402     my $title     = '';
1403     my $subtitle  = '';
1404     my $pubyear   = '';
1405     my $isbn      = '';
1406     my $issn      = '';
1407     my $publisher = '';
1408     my $pages     = '';
1409     my $titletype = 'b';
1410
1411     # For the purposes of generating COinS metadata, LDR/06-07 can be
1412     # considered the same for UNIMARC and MARC21
1413     my $fmts6;
1414     my $fmts7;
1415     %$fmts6 = (
1416                 'a' => 'book',
1417                 'b' => 'manuscript',
1418                 'c' => 'book',
1419                 'd' => 'manuscript',
1420                 'e' => 'map',
1421                 'f' => 'map',
1422                 'g' => 'film',
1423                 'i' => 'audioRecording',
1424                 'j' => 'audioRecording',
1425                 'k' => 'artwork',
1426                 'l' => 'document',
1427                 'm' => 'computerProgram',
1428                 'o' => 'document',
1429                 'r' => 'document',
1430             );
1431     %$fmts7 = (
1432                     'a' => 'journalArticle',
1433                     's' => 'journal',
1434               );
1435
1436     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1437
1438     if ( $genre eq 'book' ) {
1439             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1440     }
1441
1442     ##### We must transform mtx to a valable mtx and document type ####
1443     if ( $genre eq 'book' ) {
1444             $mtx = 'book';
1445     } elsif ( $genre eq 'journal' ) {
1446             $mtx = 'journal';
1447             $titletype = 'j';
1448     } elsif ( $genre eq 'journalArticle' ) {
1449             $mtx   = 'journal';
1450             $genre = 'article';
1451             $titletype = 'a';
1452     } else {
1453             $mtx = 'dc';
1454     }
1455
1456     $genre = ( $mtx eq 'dc' ) ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
1457
1458     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1459
1460         # Setting datas
1461         $aulast  = $record->subfield( '700', 'a' ) || '';
1462         $aufirst = $record->subfield( '700', 'b' ) || '';
1463         $oauthors = "&amp;rft.au=$aufirst $aulast";
1464
1465         # others authors
1466         if ( $record->field('200') ) {
1467             for my $au ( $record->field('200')->subfield('g') ) {
1468                 $oauthors .= "&amp;rft.au=$au";
1469             }
1470         }
1471         $title =
1472           ( $mtx eq 'dc' )
1473           ? "&amp;rft.title=" . $record->subfield( '200', 'a' )
1474           : "&amp;rft.title=" . $record->subfield( '200', 'a' ) . "&amp;rft.btitle=" . $record->subfield( '200', 'a' );
1475         $pubyear   = $record->subfield( '210', 'd' ) || '';
1476         $publisher = $record->subfield( '210', 'c' ) || '';
1477         $isbn      = $record->subfield( '010', 'a' ) || '';
1478         $issn      = $record->subfield( '011', 'a' ) || '';
1479     } else {
1480
1481         # MARC21 need some improve
1482
1483         # Setting datas
1484         if ( $record->field('100') ) {
1485             $oauthors .= "&amp;rft.au=" . $record->subfield( '100', 'a' );
1486         }
1487
1488         # others authors
1489         if ( $record->field('700') ) {
1490             for my $au ( $record->field('700')->subfield('a') ) {
1491                 $oauthors .= "&amp;rft.au=$au";
1492             }
1493         }
1494         $title = "&amp;rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1495         $subtitle = $record->subfield( '245', 'b' ) || '';
1496         $title .= $subtitle;
1497         if ($titletype eq 'a') {
1498             $pubyear   = $record->field('008') || '';
1499             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
1500             $isbn      = $record->subfield( '773', 'z' ) || '';
1501             $issn      = $record->subfield( '773', 'x' ) || '';
1502             if ($mtx eq 'journal') {
1503                 $title    .= "&amp;rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1504             } else {
1505                 $title    .= "&amp;rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1506             }
1507             foreach my $rel ($record->subfield( '773', 'g' )) {
1508                 if ($pages) {
1509                     $pages .= ', ';
1510                 }
1511                 $pages .= $rel;
1512             }
1513         } else {
1514             $pubyear   = $record->subfield( '260', 'c' ) || '';
1515             $publisher = $record->subfield( '260', 'b' ) || '';
1516             $isbn      = $record->subfield( '020', 'a' ) || '';
1517             $issn      = $record->subfield( '022', 'a' ) || '';
1518         }
1519
1520     }
1521     my $coins_value =
1522 "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";
1523     $coins_value =~ s/(\ |&[^a])/\+/g;
1524     $coins_value =~ s/\"/\&quot\;/g;
1525
1526 #<!-- 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="
1527
1528     return $coins_value;
1529 }
1530
1531
1532 =head2 GetMarcPrice
1533
1534 return the prices in accordance with the Marc format.
1535
1536 returns 0 if no price found
1537 returns undef if called without a marc record or with
1538 an unrecognized marc format
1539
1540 =cut
1541
1542 sub GetMarcPrice {
1543     my ( $record, $marcflavour ) = @_;
1544     if (!$record) {
1545         carp 'GetMarcPrice called on undefined record';
1546         return;
1547     }
1548
1549     my @listtags;
1550     my $subfield;
1551
1552     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1553         @listtags = ('345', '020');
1554         $subfield="c";
1555     } elsif ( $marcflavour eq "UNIMARC" ) {
1556         @listtags = ('345', '010');
1557         $subfield="d";
1558     } else {
1559         return;
1560     }
1561
1562     for my $field ( $record->field(@listtags) ) {
1563         for my $subfield_value  ($field->subfield($subfield)){
1564             #check value
1565             $subfield_value = MungeMarcPrice( $subfield_value );
1566             return $subfield_value if ($subfield_value);
1567         }
1568     }
1569     return 0; # no price found
1570 }
1571
1572 =head2 MungeMarcPrice
1573
1574 Return the best guess at what the actual price is from a price field.
1575 =cut
1576
1577 sub MungeMarcPrice {
1578     my ( $price ) = @_;
1579     return unless ( $price =~ m/\d/ ); ## No digits means no price.
1580     # Look for the currency symbol and the normalized code of the active currency, if it's there,
1581     my $active_currency = Koha::Acquisition::Currencies->get_active;
1582     my $symbol = $active_currency->symbol;
1583     my $isocode = $active_currency->isocode;
1584     $isocode = $active_currency->currency unless defined $isocode;
1585     my $localprice;
1586     if ( $symbol ) {
1587         my @matches =($price=~ /
1588             \s?
1589             (                          # start of capturing parenthesis
1590             (?:
1591             (?:[\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'
1592             |(?:\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'
1593             )
1594             \s?\p{Sc}?\s?              # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1595             (?:
1596             (?:[\p{Sc}\p{L}\/.]){1,4}  # followed by same block as symbol block
1597             |(?:\d+[\p{P}\s]?){1,4}    # or by same block as digits block
1598             )
1599             \s?\p{L}{0,4}\s?           # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1600             )                          # end of capturing parenthesis
1601             (?:\p{P}|\z)               # followed by a punctuation sign or by the end of the string
1602             /gx);
1603
1604         if ( @matches ) {
1605             foreach ( @matches ) {
1606                 $localprice = $_ and last if index($_, $isocode)>=0;
1607             }
1608             if ( !$localprice ) {
1609                 foreach ( @matches ) {
1610                     $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1611                 }
1612             }
1613         }
1614     }
1615     if ( $localprice ) {
1616         $price = $localprice;
1617     } else {
1618         ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1619         ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1620     }
1621     # eliminate symbol/isocode, space and any final dot from the string
1622     $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1623     # remove comma,dot when used as separators from hundreds
1624     $price =~s/[\,\.](\d{3})/$1/g;
1625     # convert comma to dot to ensure correct display of decimals if existing
1626     $price =~s/,/./;
1627     return $price;
1628 }
1629
1630
1631 =head2 GetMarcQuantity
1632
1633 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1634 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1635
1636 returns 0 if no quantity found
1637 returns undef if called without a marc record or with
1638 an unrecognized marc format
1639
1640 =cut
1641
1642 sub GetMarcQuantity {
1643     my ( $record, $marcflavour ) = @_;
1644     if (!$record) {
1645         carp 'GetMarcQuantity called on undefined record';
1646         return;
1647     }
1648
1649     my @listtags;
1650     my $subfield;
1651
1652     if ( $marcflavour eq "MARC21" ) {
1653         return 0
1654     } elsif ( $marcflavour eq "UNIMARC" ) {
1655         @listtags = ('969');
1656         $subfield="a";
1657     } else {
1658         return;
1659     }
1660
1661     for my $field ( $record->field(@listtags) ) {
1662         for my $subfield_value  ($field->subfield($subfield)){
1663             #check value
1664             if ($subfield_value) {
1665                  # in France, the cents separator is the , but sometimes, ppl use a .
1666                  # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1667                 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1668                 return $subfield_value;
1669             }
1670         }
1671     }
1672     return 0; # no price found
1673 }
1674
1675
1676 =head2 GetAuthorisedValueDesc
1677
1678   my $subfieldvalue =get_authorised_value_desc(
1679     $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1680
1681 Retrieve the complete description for a given authorised value.
1682
1683 Now takes $category and $value pair too.
1684
1685   my $auth_value_desc =GetAuthorisedValueDesc(
1686     '','', 'DVD' ,'','','CCODE');
1687
1688 If the optional $opac parameter is set to a true value, displays OPAC
1689 descriptions rather than normal ones when they exist.
1690
1691 =cut
1692
1693 sub GetAuthorisedValueDesc {
1694     my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1695
1696     if ( !$category ) {
1697
1698         return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1699
1700         #---- branch
1701         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1702             return Koha::Libraries->find($value)->branchname;
1703         }
1704
1705         #---- itemtypes
1706         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1707             return getitemtypeinfo($value)->{translated_description};
1708         }
1709
1710         #---- "true" authorized value
1711         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1712     }
1713
1714     my $dbh = C4::Context->dbh;
1715     if ( $category ne "" ) {
1716         my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1717         $sth->execute( $category, $value );
1718         my $data = $sth->fetchrow_hashref;
1719         return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1720     } else {
1721         return $value;    # if nothing is found return the original value
1722     }
1723 }
1724
1725 =head2 GetMarcControlnumber
1726
1727   $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1728
1729 Get the control number / record Identifier from the MARC record and return it.
1730
1731 =cut
1732
1733 sub GetMarcControlnumber {
1734     my ( $record, $marcflavour ) = @_;
1735     if (!$record) {
1736         carp 'GetMarcControlnumber called on undefined record';
1737         return;
1738     }
1739     my $controlnumber = "";
1740     # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1741     # Keep $marcflavour for possible later use
1742     if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1743         my $controlnumberField = $record->field('001');
1744         if ($controlnumberField) {
1745             $controlnumber = $controlnumberField->data();
1746         }
1747     }
1748     return $controlnumber;
1749 }
1750
1751 =head2 GetMarcISBN
1752
1753   $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1754
1755 Get all ISBNs from the MARC record and returns them in an array.
1756 ISBNs stored in different fields depending on MARC flavour
1757
1758 =cut
1759
1760 sub GetMarcISBN {
1761     my ( $record, $marcflavour ) = @_;
1762     if (!$record) {
1763         carp 'GetMarcISBN called on undefined record';
1764         return;
1765     }
1766     my $scope;
1767     if ( $marcflavour eq "UNIMARC" ) {
1768         $scope = '010';
1769     } else {    # assume marc21 if not unimarc
1770         $scope = '020';
1771     }
1772
1773     my @marcisbns;
1774     foreach my $field ( $record->field($scope) ) {
1775         my $isbn = $field->subfield( 'a' );
1776         if ( $isbn ne "" ) {
1777             push @marcisbns, $isbn;
1778         }
1779     }
1780
1781     return \@marcisbns;
1782 }    # end GetMarcISBN
1783
1784
1785 =head2 GetMarcISSN
1786
1787   $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1788
1789 Get all valid ISSNs from the MARC record and returns them in an array.
1790 ISSNs are stored in different fields depending on MARC flavour
1791
1792 =cut
1793
1794 sub GetMarcISSN {
1795     my ( $record, $marcflavour ) = @_;
1796     if (!$record) {
1797         carp 'GetMarcISSN called on undefined record';
1798         return;
1799     }
1800     my $scope;
1801     if ( $marcflavour eq "UNIMARC" ) {
1802         $scope = '011';
1803     }
1804     else {    # assume MARC21 or NORMARC
1805         $scope = '022';
1806     }
1807     my @marcissns;
1808     foreach my $field ( $record->field($scope) ) {
1809         push @marcissns, $field->subfield( 'a' )
1810             if ( $field->subfield( 'a' ) ne "" );
1811     }
1812     return \@marcissns;
1813 }    # end GetMarcISSN
1814
1815 =head2 GetMarcNotes
1816
1817     $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1818
1819     Get all notes from the MARC record and returns them in an array.
1820     The notes are stored in different fields depending on MARC flavour.
1821     MARC21 field 555 gets special attention for the $u subfields.
1822
1823 =cut
1824
1825 sub GetMarcNotes {
1826     my ( $record, $marcflavour ) = @_;
1827     if (!$record) {
1828         carp 'GetMarcNotes called on undefined record';
1829         return;
1830     }
1831
1832     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1833     my @marcnotes;
1834     my %blacklist = map { $_ => 1 }
1835         split( /,/, C4::Context->preference('NotesBlacklist'));
1836     foreach my $field ( $record->field($scope) ) {
1837         my $tag = $field->tag();
1838         next if $blacklist{ $tag };
1839         if( $marcflavour ne 'UNIMARC' && $tag =~ /555/ ) {
1840             # Field 555$u contains URLs
1841             # We first push the regular subfields and all $u's separately
1842             # Leave further actions to the template
1843             push @marcnotes, { marcnote => $field->as_string('abcd') };
1844             foreach my $sub ( $field->subfield('u') ) {
1845                 push @marcnotes, { marcnote => $sub };
1846             }
1847         } else {
1848             push @marcnotes, { marcnote => $field->as_string() };
1849         }
1850     }
1851     return \@marcnotes;
1852 }
1853
1854 =head2 GetMarcSubjects
1855
1856   $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1857
1858 Get all subjects from the MARC record and returns them in an array.
1859 The subjects are stored in different fields depending on MARC flavour
1860
1861 =cut
1862
1863 sub GetMarcSubjects {
1864     my ( $record, $marcflavour ) = @_;
1865     if (!$record) {
1866         carp 'GetMarcSubjects called on undefined record';
1867         return;
1868     }
1869     my ( $mintag, $maxtag, $fields_filter );
1870     if ( $marcflavour eq "UNIMARC" ) {
1871         $mintag = "600";
1872         $maxtag = "611";
1873         $fields_filter = '6..';
1874     } else { # marc21/normarc
1875         $mintag = "600";
1876         $maxtag = "699";
1877         $fields_filter = '6..';
1878     }
1879
1880     my @marcsubjects;
1881
1882     my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1883     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1884
1885     foreach my $field ( $record->field($fields_filter) ) {
1886         next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1887         my @subfields_loop;
1888         my @subfields = $field->subfields();
1889         my @link_loop;
1890
1891         # if there is an authority link, build the links with an= subfield9
1892         my $subfield9 = $field->subfield('9');
1893         my $authoritylink;
1894         if ($subfield9) {
1895             my $linkvalue = $subfield9;
1896             $linkvalue =~ s/(\(|\))//g;
1897             @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1898             $authoritylink = $linkvalue
1899         }
1900
1901         # other subfields
1902         for my $subject_subfield (@subfields) {
1903             next if ( $subject_subfield->[0] eq '9' );
1904
1905             # don't load unimarc subfields 3,4,5
1906             next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1907             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1908             next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1909
1910             my $code      = $subject_subfield->[0];
1911             my $value     = $subject_subfield->[1];
1912             my $linkvalue = $value;
1913             $linkvalue =~ s/(\(|\))//g;
1914             # if no authority link, build a search query
1915             unless ($subfield9) {
1916                 push @link_loop, {
1917                     limit    => $subject_limit,
1918                     'link'   => $linkvalue,
1919                     operator => (scalar @link_loop) ? ' and ' : undef
1920                 };
1921             }
1922             my @this_link_loop = @link_loop;
1923             # do not display $0
1924             unless ( $code eq '0' ) {
1925                 push @subfields_loop, {
1926                     code      => $code,
1927                     value     => $value,
1928                     link_loop => \@this_link_loop,
1929                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1930                 };
1931             }
1932         }
1933
1934         push @marcsubjects, {
1935             MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1936             authoritylink => $authoritylink,
1937         } if $authoritylink || @subfields_loop;
1938
1939     }
1940     return \@marcsubjects;
1941 }    #end getMARCsubjects
1942
1943 =head2 GetMarcAuthors
1944
1945   authors = GetMarcAuthors($record,$marcflavour);
1946
1947 Get all authors from the MARC record and returns them in an array.
1948 The authors are stored in different fields depending on MARC flavour
1949
1950 =cut
1951
1952 sub GetMarcAuthors {
1953     my ( $record, $marcflavour ) = @_;
1954     if (!$record) {
1955         carp 'GetMarcAuthors called on undefined record';
1956         return;
1957     }
1958     my ( $mintag, $maxtag, $fields_filter );
1959
1960     # tagslib useful for UNIMARC author reponsabilities
1961     my $tagslib =
1962       &GetMarcStructure( 1, '' );    # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
1963     if ( $marcflavour eq "UNIMARC" ) {
1964         $mintag = "700";
1965         $maxtag = "712";
1966         $fields_filter = '7..';
1967     } else { # marc21/normarc
1968         $mintag = "700";
1969         $maxtag = "720";
1970         $fields_filter = '7..';
1971     }
1972
1973     my @marcauthors;
1974     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1975
1976     foreach my $field ( $record->field($fields_filter) ) {
1977         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1978         my @subfields_loop;
1979         my @link_loop;
1980         my @subfields  = $field->subfields();
1981         my $count_auth = 0;
1982
1983         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1984         my $subfield9 = $field->subfield('9');
1985         if ($subfield9) {
1986             my $linkvalue = $subfield9;
1987             $linkvalue =~ s/(\(|\))//g;
1988             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1989         }
1990
1991         # other subfields
1992         my $unimarc3;
1993         for my $authors_subfield (@subfields) {
1994             next if ( $authors_subfield->[0] eq '9' );
1995
1996             # unimarc3 contains the $3 of the author for UNIMARC.
1997             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1998             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1999
2000             # don't load unimarc subfields 3, 5
2001             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
2002
2003             my $code = $authors_subfield->[0];
2004             my $value        = $authors_subfield->[1];
2005             my $linkvalue    = $value;
2006             $linkvalue =~ s/(\(|\))//g;
2007             # UNIMARC author responsibility
2008             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
2009                 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
2010                 $linkvalue = "($value)";
2011             }
2012             # if no authority link, build a search query
2013             unless ($subfield9) {
2014                 push @link_loop, {
2015                     limit    => 'au',
2016                     'link'   => $linkvalue,
2017                     operator => (scalar @link_loop) ? ' and ' : undef
2018                 };
2019             }
2020             my @this_link_loop = @link_loop;
2021             # do not display $0
2022             unless ( $code eq '0') {
2023                 push @subfields_loop, {
2024                     tag       => $field->tag(),
2025                     code      => $code,
2026                     value     => $value,
2027                     link_loop => \@this_link_loop,
2028                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
2029                 };
2030             }
2031         }
2032         push @marcauthors, {
2033             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
2034             authoritylink => $subfield9,
2035             unimarc3 => $unimarc3
2036         };
2037     }
2038     return \@marcauthors;
2039 }
2040
2041 =head2 GetMarcUrls
2042
2043   $marcurls = GetMarcUrls($record,$marcflavour);
2044
2045 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
2046 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
2047
2048 =cut
2049
2050 sub GetMarcUrls {
2051     my ( $record, $marcflavour ) = @_;
2052     if (!$record) {
2053         carp 'GetMarcUrls called on undefined record';
2054         return;
2055     }
2056
2057     my @marcurls;
2058     for my $field ( $record->field('856') ) {
2059         my @notes;
2060         for my $note ( $field->subfield('z') ) {
2061             push @notes, { note => $note };
2062         }
2063         my @urls = $field->subfield('u');
2064         foreach my $url (@urls) {
2065             my $marcurl;
2066             if ( $marcflavour eq 'MARC21' ) {
2067                 my $s3   = $field->subfield('3');
2068                 my $link = $field->subfield('y');
2069                 unless ( $url =~ /^\w+:/ ) {
2070                     if ( $field->indicator(1) eq '7' ) {
2071                         $url = $field->subfield('2') . "://" . $url;
2072                     } elsif ( $field->indicator(1) eq '1' ) {
2073                         $url = 'ftp://' . $url;
2074                     } else {
2075
2076                         #  properly, this should be if ind1=4,
2077                         #  however we will assume http protocol since we're building a link.
2078                         $url = 'http://' . $url;
2079                     }
2080                 }
2081
2082                 # TODO handle ind 2 (relationship)
2083                 $marcurl = {
2084                     MARCURL => $url,
2085                     notes   => \@notes,
2086                 };
2087                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
2088                 $marcurl->{'part'} = $s3 if ($link);
2089                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
2090             } else {
2091                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
2092                 $marcurl->{'MARCURL'} = $url;
2093             }
2094             push @marcurls, $marcurl;
2095         }
2096     }
2097     return \@marcurls;
2098 }
2099
2100 =head2 GetMarcSeries
2101
2102   $marcseriesarray = GetMarcSeries($record,$marcflavour);
2103
2104 Get all series from the MARC record and returns them in an array.
2105 The series are stored in different fields depending on MARC flavour
2106
2107 =cut
2108
2109 sub GetMarcSeries {
2110     my ( $record, $marcflavour ) = @_;
2111     if (!$record) {
2112         carp 'GetMarcSeries called on undefined record';
2113         return;
2114     }
2115
2116     my ( $mintag, $maxtag, $fields_filter );
2117     if ( $marcflavour eq "UNIMARC" ) {
2118         $mintag = "225";
2119         $maxtag = "225";
2120         $fields_filter = '2..';
2121     } else {    # marc21/normarc
2122         $mintag = "440";
2123         $maxtag = "490";
2124         $fields_filter = '4..';
2125     }
2126
2127     my @marcseries;
2128     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
2129
2130     foreach my $field ( $record->field($fields_filter) ) {
2131         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
2132         my @subfields_loop;
2133         my @subfields = $field->subfields();
2134         my @link_loop;
2135
2136         for my $series_subfield (@subfields) {
2137
2138             # ignore $9, used for authority link
2139             next if ( $series_subfield->[0] eq '9' );
2140
2141             my $volume_number;
2142             my $code      = $series_subfield->[0];
2143             my $value     = $series_subfield->[1];
2144             my $linkvalue = $value;
2145             $linkvalue =~ s/(\(|\))//g;
2146
2147             # see if this is an instance of a volume
2148             if ( $code eq 'v' ) {
2149                 $volume_number = 1;
2150             }
2151
2152             push @link_loop, {
2153                 'link' => $linkvalue,
2154                 operator => (scalar @link_loop) ? ' and ' : undef
2155             };
2156
2157             if ($volume_number) {
2158                 push @subfields_loop, { volumenum => $value };
2159             } else {
2160                 push @subfields_loop, {
2161                     code      => $code,
2162                     value     => $value,
2163                     link_loop => \@link_loop,
2164                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
2165                     volumenum => $volume_number,
2166                 }
2167             }
2168         }
2169         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2170
2171     }
2172     return \@marcseries;
2173 }    #end getMARCseriess
2174
2175 =head2 GetMarcHosts
2176
2177   $marchostsarray = GetMarcHosts($record,$marcflavour);
2178
2179 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2180
2181 =cut
2182
2183 sub GetMarcHosts {
2184     my ( $record, $marcflavour ) = @_;
2185     if (!$record) {
2186         carp 'GetMarcHosts called on undefined record';
2187         return;
2188     }
2189
2190     my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2191     $marcflavour ||="MARC21";
2192     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2193         $tag = "773";
2194         $title_subf = "t";
2195         $bibnumber_subf ="0";
2196         $itemnumber_subf='9';
2197     }
2198     elsif ($marcflavour eq "UNIMARC") {
2199         $tag = "461";
2200         $title_subf = "t";
2201         $bibnumber_subf ="0";
2202         $itemnumber_subf='9';
2203     };
2204
2205     my @marchosts;
2206
2207     foreach my $field ( $record->field($tag)) {
2208
2209         my @fields_loop;
2210
2211         my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2212         my $hosttitle = $field->subfield($title_subf);
2213         my $hostitemnumber=$field->subfield($itemnumber_subf);
2214         push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2215         push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2216
2217         }
2218     my $marchostsarray = \@marchosts;
2219     return $marchostsarray;
2220 }
2221
2222 =head2 GetFrameworkCode
2223
2224   $frameworkcode = GetFrameworkCode( $biblionumber )
2225
2226 =cut
2227
2228 sub GetFrameworkCode {
2229     my ($biblionumber) = @_;
2230     my $dbh            = C4::Context->dbh;
2231     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2232     $sth->execute($biblionumber);
2233     my ($frameworkcode) = $sth->fetchrow;
2234     return $frameworkcode;
2235 }
2236
2237 =head2 TransformKohaToMarc
2238
2239     $record = TransformKohaToMarc( $hash )
2240
2241 This function builds partial MARC::Record from a hash
2242 Hash entries can be from biblio or biblioitems.
2243
2244 This function is called in acquisition module, to create a basic catalogue
2245 entry from user entry
2246
2247 =cut
2248
2249
2250 sub TransformKohaToMarc {
2251     my $hash = shift;
2252     my $record = MARC::Record->new();
2253     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2254     # FIXME Do not we want to get the marc subfield structure for the biblio framework?
2255     my $mss = GetMarcSubfieldStructure();
2256     my $tag_hr = {};
2257     while ( my ($kohafield, $value) = each %$hash ) {
2258         next unless exists $mss->{$kohafield};
2259         next unless $mss->{$kohafield};
2260         my $tagfield    = $mss->{$kohafield}{tagfield} . '';
2261         my $tagsubfield = $mss->{$kohafield}{tagsubfield};
2262         foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2263             next if $value eq '';
2264             $tag_hr->{$tagfield} //= [];
2265             push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)];
2266         }
2267     }
2268     foreach my $tag (sort keys %$tag_hr) {
2269         my @sfl = @{$tag_hr->{$tag}};
2270         @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2271         @sfl = map { @{$_}; } @sfl;
2272         $record->insert_fields_ordered(
2273             MARC::Field->new($tag, " ", " ", @sfl)
2274         );
2275     }
2276     return $record;
2277 }
2278
2279 =head2 PrepHostMarcField
2280
2281     $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2282
2283 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2284
2285 =cut
2286
2287 sub PrepHostMarcField {
2288     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2289     $marcflavour ||="MARC21";
2290
2291     require C4::Items;
2292     my $hostrecord = GetMarcBiblio($hostbiblionumber);
2293         my $item = C4::Items::GetItem($hostitemnumber);
2294
2295         my $hostmarcfield;
2296     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2297
2298         #main entry
2299         my $mainentry;
2300         if ($hostrecord->subfield('100','a')){
2301             $mainentry = $hostrecord->subfield('100','a');
2302         } elsif ($hostrecord->subfield('110','a')){
2303             $mainentry = $hostrecord->subfield('110','a');
2304         } else {
2305             $mainentry = $hostrecord->subfield('111','a');
2306         }
2307
2308         # qualification info
2309         my $qualinfo;
2310         if (my $field260 = $hostrecord->field('260')){
2311             $qualinfo =  $field260->as_string( 'abc' );
2312         }
2313
2314
2315         #other fields
2316         my $ed = $hostrecord->subfield('250','a');
2317         my $barcode = $item->{'barcode'};
2318         my $title = $hostrecord->subfield('245','a');
2319
2320         # record control number, 001 with 003 and prefix
2321         my $recctrlno;
2322         if ($hostrecord->field('001')){
2323             $recctrlno = $hostrecord->field('001')->data();
2324             if ($hostrecord->field('003')){
2325                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2326             }
2327         }
2328
2329         # issn/isbn
2330         my $issn = $hostrecord->subfield('022','a');
2331         my $isbn = $hostrecord->subfield('020','a');
2332
2333
2334         $hostmarcfield = MARC::Field->new(
2335                 773, '0', '',
2336                 '0' => $hostbiblionumber,
2337                 '9' => $hostitemnumber,
2338                 'a' => $mainentry,
2339                 'b' => $ed,
2340                 'd' => $qualinfo,
2341                 'o' => $barcode,
2342                 't' => $title,
2343                 'w' => $recctrlno,
2344                 'x' => $issn,
2345                 'z' => $isbn
2346                 );
2347     } elsif ($marcflavour eq "UNIMARC") {
2348         $hostmarcfield = MARC::Field->new(
2349             461, '', '',
2350             '0' => $hostbiblionumber,
2351             't' => $hostrecord->subfield('200','a'),
2352             '9' => $hostitemnumber
2353         );
2354     };
2355
2356     return $hostmarcfield;
2357 }
2358
2359 =head2 TransformHtmlToXml
2360
2361   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2362                              $ind_tag, $auth_type )
2363
2364 $auth_type contains :
2365
2366 =over
2367
2368 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2369
2370 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2371
2372 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2373
2374 =back
2375
2376 =cut
2377
2378 sub TransformHtmlToXml {
2379     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2380     # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2381
2382     my $xml = MARC::File::XML::header('UTF-8');
2383     $xml .= "<record>\n";
2384     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2385     MARC::File::XML->default_record_format($auth_type);
2386
2387     # in UNIMARC, field 100 contains the encoding
2388     # check that there is one, otherwise the
2389     # MARC::Record->new_from_xml will fail (and Koha will die)
2390     my $unimarc_and_100_exist = 0;
2391     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
2392     my $prevvalue;
2393     my $prevtag = -1;
2394     my $first   = 1;
2395     my $j       = -1;
2396     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2397
2398         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2399
2400             # if we have a 100 field and it's values are not correct, skip them.
2401             # if we don't have any valid 100 field, we will create a default one at the end
2402             my $enc = substr( @$values[$i], 26, 2 );
2403             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2404                 $unimarc_and_100_exist = 1;
2405             } else {
2406                 next;
2407             }
2408         }
2409         @$values[$i] =~ s/&/&amp;/g;
2410         @$values[$i] =~ s/</&lt;/g;
2411         @$values[$i] =~ s/>/&gt;/g;
2412         @$values[$i] =~ s/"/&quot;/g;
2413         @$values[$i] =~ s/'/&apos;/g;
2414
2415         if ( ( @$tags[$i] ne $prevtag ) ) {
2416             $j++ unless ( @$tags[$i] eq "" );
2417             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2418             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2419             my $ind1       = _default_ind_to_space($indicator1);
2420             my $ind2;
2421             if ( @$indicator[$j] ) {
2422                 $ind2 = _default_ind_to_space($indicator2);
2423             } else {
2424                 warn "Indicator in @$tags[$i] is empty";
2425                 $ind2 = " ";
2426             }
2427             if ( !$first ) {
2428                 $xml .= "</datafield>\n";
2429                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2430                     && ( @$values[$i] ne "" ) ) {
2431                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2432                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2433                     $first = 0;
2434                 } else {
2435                     $first = 1;
2436                 }
2437             } else {
2438                 if ( @$values[$i] ne "" ) {
2439
2440                     # leader
2441                     if ( @$tags[$i] eq "000" ) {
2442                         $xml .= "<leader>@$values[$i]</leader>\n";
2443                         $first = 1;
2444
2445                         # rest of the fixed fields
2446                     } elsif ( @$tags[$i] < 10 ) {
2447                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2448                         $first = 1;
2449                     } else {
2450                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2451                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2452                         $first = 0;
2453                     }
2454                 }
2455             }
2456         } else {    # @$tags[$i] eq $prevtag
2457             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2458             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2459             my $ind1       = _default_ind_to_space($indicator1);
2460             my $ind2;
2461             if ( @$indicator[$j] ) {
2462                 $ind2 = _default_ind_to_space($indicator2);
2463             } else {
2464                 warn "Indicator in @$tags[$i] is empty";
2465                 $ind2 = " ";
2466             }
2467             if ( @$values[$i] eq "" ) {
2468             } else {
2469                 if ($first) {
2470                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2471                     $first = 0;
2472                 }
2473                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2474             }
2475         }
2476         $prevtag = @$tags[$i];
2477     }
2478     $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2479     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2480
2481         #     warn "SETTING 100 for $auth_type";
2482         my $string = strftime( "%Y%m%d", localtime(time) );
2483
2484         # set 50 to position 26 is biblios, 13 if authorities
2485         my $pos = 26;
2486         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2487         $string = sprintf( "%-*s", 35, $string );
2488         substr( $string, $pos, 6, "50" );
2489         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2490         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2491         $xml .= "</datafield>\n";
2492     }
2493     $xml .= "</record>\n";
2494     $xml .= MARC::File::XML::footer();
2495     return $xml;
2496 }
2497
2498 =head2 _default_ind_to_space
2499
2500 Passed what should be an indicator returns a space
2501 if its undefined or zero length
2502
2503 =cut
2504
2505 sub _default_ind_to_space {
2506     my $s = shift;
2507     if ( !defined $s || $s eq q{} ) {
2508         return ' ';
2509     }
2510     return $s;
2511 }
2512
2513 =head2 TransformHtmlToMarc
2514
2515     L<$record> = TransformHtmlToMarc(L<$cgi>)
2516     L<$cgi> is the CGI object which containts the values for subfields
2517     {
2518         'tag_010_indicator1_531951' ,
2519         'tag_010_indicator2_531951' ,
2520         'tag_010_code_a_531951_145735' ,
2521         'tag_010_subfield_a_531951_145735' ,
2522         'tag_200_indicator1_873510' ,
2523         'tag_200_indicator2_873510' ,
2524         'tag_200_code_a_873510_673465' ,
2525         'tag_200_subfield_a_873510_673465' ,
2526         'tag_200_code_b_873510_704318' ,
2527         'tag_200_subfield_b_873510_704318' ,
2528         'tag_200_code_e_873510_280822' ,
2529         'tag_200_subfield_e_873510_280822' ,
2530         'tag_200_code_f_873510_110730' ,
2531         'tag_200_subfield_f_873510_110730' ,
2532     }
2533     L<$record> is the MARC::Record object.
2534
2535 =cut
2536
2537 sub TransformHtmlToMarc {
2538     my ($cgi, $isbiblio) = @_;
2539
2540     my @params = $cgi->multi_param();
2541
2542     # explicitly turn on the UTF-8 flag for all
2543     # 'tag_' parameters to avoid incorrect character
2544     # conversion later on
2545     my $cgi_params = $cgi->Vars;
2546     foreach my $param_name ( keys %$cgi_params ) {
2547         if ( $param_name =~ /^tag_/ ) {
2548             my $param_value = $cgi_params->{$param_name};
2549             unless ( Encode::is_utf8( $param_value ) ) {
2550                 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2551             }
2552         }
2553     }
2554
2555     # creating a new record
2556     my $record = MARC::Record->new();
2557     my @fields;
2558     my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2559     ($biblionumbertagfield, $biblionumbertagsubfield) =
2560         &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2561 #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!
2562     for (my $i = 0; $params[$i]; $i++ ) {    # browse all CGI params
2563         my $param    = $params[$i];
2564         my $newfield = 0;
2565
2566         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2567         if ( $param eq 'biblionumber' ) {
2568             if ( $biblionumbertagfield < 10 ) {
2569                 $newfield = MARC::Field->new( $biblionumbertagfield, scalar $cgi->param($param), );
2570             } else {
2571                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => scalar $cgi->param($param), );
2572             }
2573             push @fields, $newfield if ($newfield);
2574         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2575             my $tag = $1;
2576
2577             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2578             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2579             $newfield = 0;
2580             my $j = $i + 2;
2581
2582             if ( $tag < 10 ) {                              # no code for theses fields
2583                                                             # in MARC editor, 000 contains the leader.
2584                 next if $tag == $biblionumbertagfield;
2585                 my $fval= $cgi->param($params[$j+1]);
2586                 if ( $tag eq '000' ) {
2587                     # Force a fake leader even if not provided to avoid crashing
2588                     # during decoding MARC record containing UTF-8 characters
2589                     $record->leader(
2590                         length( $fval ) == 24
2591                         ? $fval
2592                         : '     nam a22        4500'
2593                         )
2594                     ;
2595                     # between 001 and 009 (included)
2596                 } elsif ( $fval ne '' ) {
2597                     $newfield = MARC::Field->new( $tag, $fval, );
2598                 }
2599
2600                 # > 009, deal with subfields
2601             } else {
2602                 # browse subfields for this tag (reason for _code_ match)
2603                 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2604                     last unless defined $params[$j+1];
2605                     $j += 2 and next
2606                         if $tag == $biblionumbertagfield and
2607                            $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2608                     #if next param ne subfield, then it was probably empty
2609                     #try next param by incrementing j
2610                     if($params[$j+1]!~/_subfield_/) {$j++; next; }
2611                     my $fkey= $cgi->param($params[$j]);
2612                     my $fval= $cgi->param($params[$j+1]);
2613                     #check if subfield value not empty and field exists
2614                     if($fval ne '' && $newfield) {
2615                         $newfield->add_subfields( $fkey => $fval);
2616                     }
2617                     elsif($fval ne '') {
2618                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $fkey => $fval );
2619                     }
2620                     $j += 2;
2621                 } #end-of-while
2622                 $i= $j-1; #update i for outer loop accordingly
2623             }
2624             push @fields, $newfield if ($newfield);
2625         }
2626     }
2627
2628     $record->append_fields(@fields);
2629     return $record;
2630 }
2631
2632 =head2 TransformMarcToKoha
2633
2634   $result = TransformMarcToKoha( $record, $frameworkcode )
2635
2636 Extract data from a MARC bib record into a hashref representing
2637 Koha biblio, biblioitems, and items fields.
2638
2639 If passed an undefined record will log the error and return an empty
2640 hash_ref
2641
2642 =cut
2643
2644 sub TransformMarcToKoha {
2645     my ( $record, $frameworkcode, $limit_table ) = @_;
2646
2647     my $result = {};
2648     if (!defined $record) {
2649         carp('TransformMarcToKoha called with undefined record');
2650         return $result;
2651     }
2652     $limit_table = $limit_table || 0;
2653     $frameworkcode = '' unless defined $frameworkcode;
2654
2655     my $inverted_field_map = _get_inverted_marc_field_map($frameworkcode);
2656
2657     my %tables = ();
2658     if ( defined $limit_table && $limit_table eq 'items' ) {
2659         $tables{'items'} = 1;
2660     } else {
2661         $tables{'items'}       = 1;
2662         $tables{'biblio'}      = 1;
2663         $tables{'biblioitems'} = 1;
2664     }
2665
2666     # traverse through record
2667   MARCFIELD: foreach my $field ( $record->fields() ) {
2668         my $tag = $field->tag();
2669         next MARCFIELD unless exists $inverted_field_map->{$tag};
2670         if ( $field->is_control_field() ) {
2671             my $kohafields = $inverted_field_map->{$tag}->{list};
2672           ENTRY: foreach my $entry ( @{$kohafields} ) {
2673                 my ( $subfield, $table, $column ) = @{$entry};
2674                 next ENTRY unless exists $tables{$table};
2675                 my $key = _disambiguate( $table, $column );
2676                 if ( $result->{$key} ) {
2677                     unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2678                         $result->{$key} .= " | " . $field->data();
2679                     }
2680                 } else {
2681                     $result->{$key} = $field->data();
2682                 }
2683             }
2684         } else {
2685
2686             # deal with subfields
2687           MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2688                 my $code = $sf->[0];
2689                 next MARCSUBFIELD unless exists $inverted_field_map->{$tag}->{sfs}->{$code};
2690                 my $value = $sf->[1];
2691               SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$tag}->{sfs}->{$code} } ) {
2692                     my ( $table, $column ) = @{$entry};
2693                     next SFENTRY unless exists $tables{$table};
2694                     my $key = _disambiguate( $table, $column );
2695                     if ( $result->{$key} ) {
2696                         unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2697                             $result->{$key} .= " | " . $value;
2698                         }
2699                     } else {
2700                         $result->{$key} = $value;
2701                     }
2702                 }
2703             }
2704         }
2705     }
2706
2707     # modify copyrightdate to keep only the 1st year found
2708     if ( exists $result->{'copyrightdate'} ) {
2709         my $temp = $result->{'copyrightdate'};
2710         $temp =~ m/c(\d\d\d\d)/;
2711         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2712             $result->{'copyrightdate'} = $1;
2713         } else {                                       # if no cYYYY, get the 1st date.
2714             $temp =~ m/(\d\d\d\d)/;
2715             $result->{'copyrightdate'} = $1;
2716         }
2717     }
2718
2719     # modify publicationyear to keep only the 1st year found
2720     if ( exists $result->{'publicationyear'} ) {
2721         my $temp = $result->{'publicationyear'};
2722         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2723             $result->{'publicationyear'} = $1;
2724         } else {                                       # if no cYYYY, get the 1st date.
2725             $temp =~ m/(\d\d\d\d)/;
2726             $result->{'publicationyear'} = $1;
2727         }
2728     }
2729
2730     return $result;
2731 }
2732
2733 sub _get_inverted_marc_field_map {
2734     my ( $frameworkcode ) = @_;
2735     my $field_map = {};
2736     my $mss = GetMarcSubfieldStructure( $frameworkcode );
2737
2738     foreach my $kohafield ( keys %{ $mss } ) {
2739         next unless exists $mss->{$kohafield};    # not all columns are mapped to MARC tag & subfield
2740         my $tag      = $mss->{$kohafield}{tagfield};
2741         my $subfield = $mss->{$kohafield}{tagsubfield};
2742         my ( $table, $column ) = split /[.]/, $kohafield, 2;
2743         push @{ $field_map->{$tag}->{list} }, [ $subfield, $table, $column ];
2744         push @{ $field_map->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2745     }
2746     return $field_map;
2747 }
2748
2749 =head2 _disambiguate
2750
2751   $newkey = _disambiguate($table, $field);
2752
2753 This is a temporary hack to distinguish between the
2754 following sets of columns when using TransformMarcToKoha.
2755
2756   items.cn_source & biblioitems.cn_source
2757   items.cn_sort & biblioitems.cn_sort
2758
2759 Columns that are currently NOT distinguished (FIXME
2760 due to lack of time to fully test) are:
2761
2762   biblio.notes and biblioitems.notes
2763   biblionumber
2764   timestamp
2765   biblioitemnumber
2766
2767 FIXME - this is necessary because prefixing each column
2768 name with the table name would require changing lots
2769 of code and templates, and exposing more of the DB
2770 structure than is good to the UI templates, particularly
2771 since biblio and bibloitems may well merge in a future
2772 version.  In the future, it would also be good to
2773 separate DB access and UI presentation field names
2774 more.
2775
2776 =cut
2777
2778 sub CountItemsIssued {
2779     my ($biblionumber) = @_;
2780     my $dbh            = C4::Context->dbh;
2781     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2782     $sth->execute($biblionumber);
2783     my $row = $sth->fetchrow_hashref();
2784     return $row->{'issuedCount'};
2785 }
2786
2787 sub _disambiguate {
2788     my ( $table, $column ) = @_;
2789     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2790         return $table . '.' . $column;
2791     } else {
2792         return $column;
2793     }
2794
2795 }
2796
2797 =head2 get_koha_field_from_marc
2798
2799   $result->{_disambiguate($table, $field)} =
2800      get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2801
2802 Internal function to map data from the MARC record to a specific non-MARC field.
2803 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2804
2805 =cut
2806
2807 sub get_koha_field_from_marc {
2808     my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2809     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2810     my $kohafield;
2811     foreach my $field ( $record->field($tagfield) ) {
2812         if ( $field->tag() < 10 ) {
2813             if ($kohafield) {
2814                 $kohafield .= " | " . $field->data();
2815             } else {
2816                 $kohafield = $field->data();
2817             }
2818         } else {
2819             if ( $field->subfields ) {
2820                 my @subfields = $field->subfields();
2821                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2822                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2823                         if ($kohafield) {
2824                             $kohafield .= " | " . $subfields[$subfieldcount][1];
2825                         } else {
2826                             $kohafield = $subfields[$subfieldcount][1];
2827                         }
2828                     }
2829                 }
2830             }
2831         }
2832     }
2833     return $kohafield;
2834 }
2835
2836 =head2 TransformMarcToKohaOneField
2837
2838   $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2839
2840 =cut
2841
2842 sub TransformMarcToKohaOneField {
2843
2844     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2845     # only the 1st will be retrieved...
2846     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2847     my $res = "";
2848     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2849     foreach my $field ( $record->field($tagfield) ) {
2850         if ( $field->tag() < 10 ) {
2851             if ( $result->{$kohafield} ) {
2852                 $result->{$kohafield} .= " | " . $field->data();
2853             } else {
2854                 $result->{$kohafield} = $field->data();
2855             }
2856         } else {
2857             if ( $field->subfields ) {
2858                 my @subfields = $field->subfields();
2859                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2860                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2861                         if ( $result->{$kohafield} ) {
2862                             $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2863                         } else {
2864                             $result->{$kohafield} = $subfields[$subfieldcount][1];
2865                         }
2866                     }
2867                 }
2868             }
2869         }
2870     }
2871     return $result;
2872 }
2873
2874
2875 #"
2876
2877 #
2878 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2879 # at the same time
2880 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2881 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2882 # =head2 ModZebrafiles
2883 #
2884 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2885 #
2886 # =cut
2887 #
2888 # sub ModZebrafiles {
2889 #
2890 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2891 #
2892 #     my $op;
2893 #     my $zebradir =
2894 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2895 #     unless ( opendir( DIR, "$zebradir" ) ) {
2896 #         warn "$zebradir not found";
2897 #         return;
2898 #     }
2899 #     closedir DIR;
2900 #     my $filename = $zebradir . $biblionumber;
2901 #
2902 #     if ($record) {
2903 #         open( OUTPUT, ">", $filename . ".xml" );
2904 #         print OUTPUT $record;
2905 #         close OUTPUT;
2906 #     }
2907 # }
2908
2909 =head2 ModZebra
2910
2911   ModZebra( $biblionumber, $op, $server, $record );
2912
2913 $biblionumber is the biblionumber we want to index
2914
2915 $op is specialUpdate or recordDelete, and is used to know what we want to do
2916
2917 $server is the server that we want to update
2918
2919 $record is the update MARC record if it's available. If it's not supplied
2920 and is needed, it'll be loaded from the database.
2921
2922 =cut
2923
2924 sub ModZebra {
2925 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2926     my ( $biblionumber, $op, $server, $record ) = @_;
2927     $debug && warn "ModZebra: update requested for: $biblionumber $op $server\n";
2928     if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
2929
2930         # TODO abstract to a standard API that'll work for whatever
2931         require Koha::ElasticSearch::Indexer;
2932         my $indexer = Koha::ElasticSearch::Indexer->new(
2933             {
2934                 index => $server eq 'biblioserver'
2935                 ? $Koha::SearchEngine::BIBLIOS_INDEX
2936                 : $Koha::SearchEngine::AUTHORITIES_INDEX
2937             }
2938         );
2939         if ( $op eq 'specialUpdate' ) {
2940             unless ($record) {
2941                 $record = GetMarcBiblio($biblionumber, 1);
2942             }
2943             my $records = [$record];
2944             $indexer->update_index_background( [$biblionumber], [$record] );
2945         }
2946         elsif ( $op eq 'recordDelete' ) {
2947             $indexer->delete_index_background( [$biblionumber] );
2948         }
2949         else {
2950             croak "ModZebra called with unknown operation: $op";
2951         }
2952     }
2953
2954     my $dbh = C4::Context->dbh;
2955
2956     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2957     # at the same time
2958     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2959     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2960     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2961     WHERE server = ?
2962         AND   biblio_auth_number = ?
2963         AND   operation = ?
2964         AND   done = 0";
2965     my $check_sth = $dbh->prepare_cached($check_sql);
2966     $check_sth->execute( $server, $biblionumber, $op );
2967     my ($count) = $check_sth->fetchrow_array;
2968     $check_sth->finish();
2969     if ( $count == 0 ) {
2970         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2971         $sth->execute( $biblionumber, $server, $op );
2972         $sth->finish;
2973     }
2974 }
2975
2976
2977 =head2 EmbedItemsInMarcBiblio
2978
2979     EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers, $opac);
2980
2981 Given a MARC::Record object containing a bib record,
2982 modify it to include the items attached to it as 9XX
2983 per the bib's MARC framework.
2984 if $itemnumbers is defined, only specified itemnumbers are embedded.
2985
2986 If $opac is true, then opac-relevant suppressions are included.
2987
2988 =cut
2989
2990 sub EmbedItemsInMarcBiblio {
2991     my ($marc, $biblionumber, $itemnumbers, $opac) = @_;
2992     if ( !$marc ) {
2993         carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2994         return;
2995     }
2996
2997     $itemnumbers = [] unless defined $itemnumbers;
2998
2999     my $frameworkcode = GetFrameworkCode($biblionumber);
3000     _strip_item_fields($marc, $frameworkcode);
3001
3002     # ... and embed the current items
3003     my $dbh = C4::Context->dbh;
3004     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
3005     $sth->execute($biblionumber);
3006     my @item_fields;
3007     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
3008     my @items;
3009     my $opachiddenitems = $opac
3010       && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
3011     require C4::Items;
3012     while ( my ($itemnumber) = $sth->fetchrow_array ) {
3013         next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
3014         my $i = $opachiddenitems ? C4::Items::GetItem($itemnumber) : undef;
3015         push @items, { itemnumber => $itemnumber, item => $i };
3016     }
3017     my @hiddenitems =
3018       $opachiddenitems
3019       ? C4::Items::GetHiddenItemnumbers( map { $_->{item} } @items )
3020       : ();
3021     # Convert to a hash for quick searching
3022     my %hiddenitems = map { $_ => 1 } @hiddenitems;
3023     foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
3024         next if $hiddenitems{$itemnumber};
3025         my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
3026         push @item_fields, $item_marc->field($itemtag);
3027     }
3028     $marc->append_fields(@item_fields);
3029 }
3030
3031 =head1 INTERNAL FUNCTIONS
3032
3033 =head2 _koha_marc_update_bib_ids
3034
3035
3036   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3037
3038 Internal function to add or update biblionumber and biblioitemnumber to
3039 the MARC XML.
3040
3041 =cut
3042
3043 sub _koha_marc_update_bib_ids {
3044     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3045
3046     # we must add bibnum and bibitemnum in MARC::Record...
3047     # we build the new field with biblionumber and biblioitemnumber
3048     # we drop the original field
3049     # we add the new builded field.
3050     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
3051     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
3052     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3053     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
3054
3055     if ( $biblio_tag == $biblioitem_tag ) {
3056
3057         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3058         my $new_field = MARC::Field->new(
3059             $biblio_tag, '', '',
3060             "$biblio_subfield"     => $biblionumber,
3061             "$biblioitem_subfield" => $biblioitemnumber
3062         );
3063
3064         # drop old field and create new one...
3065         my $old_field = $record->field($biblio_tag);
3066         $record->delete_field($old_field) if $old_field;
3067         $record->insert_fields_ordered($new_field);
3068     } else {
3069
3070         # biblionumber & biblioitemnumber are in different fields
3071
3072         # deal with biblionumber
3073         my ( $new_field, $old_field );
3074         if ( $biblio_tag < 10 ) {
3075             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3076         } else {
3077             $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3078         }
3079
3080         # drop old field and create new one...
3081         $old_field = $record->field($biblio_tag);
3082         $record->delete_field($old_field) if $old_field;
3083         $record->insert_fields_ordered($new_field);
3084
3085         # deal with biblioitemnumber
3086         if ( $biblioitem_tag < 10 ) {
3087             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3088         } else {
3089             $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3090         }
3091
3092         # drop old field and create new one...
3093         $old_field = $record->field($biblioitem_tag);
3094         $record->delete_field($old_field) if $old_field;
3095         $record->insert_fields_ordered($new_field);
3096     }
3097 }
3098
3099 =head2 _koha_marc_update_biblioitem_cn_sort
3100
3101   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3102
3103 Given a MARC bib record and the biblioitem hash, update the
3104 subfield that contains a copy of the value of biblioitems.cn_sort.
3105
3106 =cut
3107
3108 sub _koha_marc_update_biblioitem_cn_sort {
3109     my $marc          = shift;
3110     my $biblioitem    = shift;
3111     my $frameworkcode = shift;
3112
3113     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3114     return unless $biblioitem_tag;
3115
3116     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3117
3118     if ( my $field = $marc->field($biblioitem_tag) ) {
3119         $field->delete_subfield( code => $biblioitem_subfield );
3120         if ( $cn_sort ne '' ) {
3121             $field->add_subfields( $biblioitem_subfield => $cn_sort );
3122         }
3123     } else {
3124
3125         # if we get here, no biblioitem tag is present in the MARC record, so
3126         # we'll create it if $cn_sort is not empty -- this would be
3127         # an odd combination of events, however
3128         if ($cn_sort) {
3129             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3130         }
3131     }
3132 }
3133
3134 =head2 _koha_add_biblio
3135
3136   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3137
3138 Internal function to add a biblio ($biblio is a hash with the values)
3139
3140 =cut
3141
3142 sub _koha_add_biblio {
3143     my ( $dbh, $biblio, $frameworkcode ) = @_;
3144
3145     my $error;
3146
3147     # set the series flag
3148     unless (defined $biblio->{'serial'}){
3149         $biblio->{'serial'} = 0;
3150         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3151     }
3152
3153     my $query = "INSERT INTO biblio
3154         SET frameworkcode = ?,
3155             author = ?,
3156             title = ?,
3157             unititle =?,
3158             notes = ?,
3159             serial = ?,
3160             seriestitle = ?,
3161             copyrightdate = ?,
3162             datecreated=NOW(),
3163             abstract = ?
3164         ";
3165     my $sth = $dbh->prepare($query);
3166     $sth->execute(
3167         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3168         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3169     );
3170
3171     my $biblionumber = $dbh->{'mysql_insertid'};
3172     if ( $dbh->errstr ) {
3173         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3174         warn $error;
3175     }
3176
3177     $sth->finish();
3178
3179     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3180     return ( $biblionumber, $error );
3181 }
3182
3183 =head2 _koha_modify_biblio
3184
3185   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3186
3187 Internal function for updating the biblio table
3188
3189 =cut
3190
3191 sub _koha_modify_biblio {
3192     my ( $dbh, $biblio, $frameworkcode ) = @_;
3193     my $error;
3194
3195     my $query = "
3196         UPDATE biblio
3197         SET    frameworkcode = ?,
3198                author = ?,
3199                title = ?,
3200                unititle = ?,
3201                notes = ?,
3202                serial = ?,
3203                seriestitle = ?,
3204                copyrightdate = ?,
3205                abstract = ?
3206         WHERE  biblionumber = ?
3207         "
3208       ;
3209     my $sth = $dbh->prepare($query);
3210
3211     $sth->execute(
3212         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3213         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3214     ) if $biblio->{'biblionumber'};
3215
3216     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3217         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3218         warn $error;
3219     }
3220     return ( $biblio->{'biblionumber'}, $error );
3221 }
3222
3223 =head2 _koha_modify_biblioitem_nonmarc
3224
3225   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3226
3227 Updates biblioitems row except for marc and marcxml, which should be changed
3228 via ModBiblioMarc
3229
3230 =cut
3231
3232 sub _koha_modify_biblioitem_nonmarc {
3233     my ( $dbh, $biblioitem ) = @_;
3234     my $error;
3235
3236     # re-calculate the cn_sort, it may have changed
3237     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3238
3239     my $query = "UPDATE biblioitems
3240     SET biblionumber    = ?,
3241         volume          = ?,
3242         number          = ?,
3243         itemtype        = ?,
3244         isbn            = ?,
3245         issn            = ?,
3246         publicationyear = ?,
3247         publishercode   = ?,
3248         volumedate      = ?,
3249         volumedesc      = ?,
3250         collectiontitle = ?,
3251         collectionissn  = ?,
3252         collectionvolume= ?,
3253         editionstatement= ?,
3254         editionresponsibility = ?,
3255         illus           = ?,
3256         pages           = ?,
3257         notes           = ?,
3258         size            = ?,
3259         place           = ?,
3260         lccn            = ?,
3261         url             = ?,
3262         cn_source       = ?,
3263         cn_class        = ?,
3264         cn_item         = ?,
3265         cn_suffix       = ?,
3266         cn_sort         = ?,
3267         totalissues     = ?,
3268         ean             = ?,
3269         agerestriction  = ?
3270         where biblioitemnumber = ?
3271         ";
3272     my $sth = $dbh->prepare($query);
3273     $sth->execute(
3274         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3275         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3276         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3277         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3278         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3279         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3280         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3281         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
3282     );
3283     if ( $dbh->errstr ) {
3284         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3285         warn $error;
3286     }
3287     return ( $biblioitem->{'biblioitemnumber'}, $error );
3288 }
3289
3290 =head2 _koha_add_biblioitem
3291
3292   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3293
3294 Internal function to add a biblioitem
3295
3296 =cut
3297
3298 sub _koha_add_biblioitem {
3299     my ( $dbh, $biblioitem ) = @_;
3300     my $error;
3301
3302     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3303     my $query = "INSERT INTO biblioitems SET
3304         biblionumber    = ?,
3305         volume          = ?,
3306         number          = ?,
3307         itemtype        = ?,
3308         isbn            = ?,
3309         issn            = ?,
3310         publicationyear = ?,
3311         publishercode   = ?,
3312         volumedate      = ?,
3313         volumedesc      = ?,
3314         collectiontitle = ?,
3315         collectionissn  = ?,
3316         collectionvolume= ?,
3317         editionstatement= ?,
3318         editionresponsibility = ?,
3319         illus           = ?,
3320         pages           = ?,
3321         notes           = ?,
3322         size            = ?,
3323         place           = ?,
3324         lccn            = ?,
3325         marc            = ?,
3326         url             = ?,
3327         cn_source       = ?,
3328         cn_class        = ?,
3329         cn_item         = ?,
3330         cn_suffix       = ?,
3331         cn_sort         = ?,
3332         totalissues     = ?,
3333         ean             = ?,
3334         agerestriction  = ?
3335         ";
3336     my $sth = $dbh->prepare($query);
3337     $sth->execute(
3338         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3339         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3340         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3341         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3342         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3343         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3344         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3345         $biblioitem->{'totalissues'},      $biblioitem->{'ean'},              $biblioitem->{'agerestriction'}
3346     );
3347     my $bibitemnum = $dbh->{'mysql_insertid'};
3348
3349     if ( $dbh->errstr ) {
3350         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3351         warn $error;
3352     }
3353     $sth->finish();
3354     return ( $bibitemnum, $error );
3355 }
3356
3357 =head2 _koha_delete_biblio
3358
3359   $error = _koha_delete_biblio($dbh,$biblionumber);
3360
3361 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3362
3363 C<$dbh> - the database handle
3364
3365 C<$biblionumber> - the biblionumber of the biblio to be deleted
3366
3367 =cut
3368
3369 # FIXME: add error handling
3370
3371 sub _koha_delete_biblio {
3372     my ( $dbh, $biblionumber ) = @_;
3373
3374     # get all the data for this biblio
3375     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3376     $sth->execute($biblionumber);
3377
3378     if ( my $data = $sth->fetchrow_hashref ) {
3379
3380         # save the record in deletedbiblio
3381         # find the fields to save
3382         my $query = "INSERT INTO deletedbiblio SET ";
3383         my @bind  = ();
3384         foreach my $temp ( keys %$data ) {
3385             $query .= "$temp = ?,";
3386             push( @bind, $data->{$temp} );
3387         }
3388
3389         # replace the last , by ",?)"
3390         $query =~ s/\,$//;
3391         my $bkup_sth = $dbh->prepare($query);
3392         $bkup_sth->execute(@bind);
3393         $bkup_sth->finish;
3394
3395         # delete the biblio
3396         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3397         $sth2->execute($biblionumber);
3398         # update the timestamp (Bugzilla 7146)
3399         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3400         $sth2->execute($biblionumber);
3401         $sth2->finish;
3402     }
3403     $sth->finish;
3404     return;
3405 }
3406
3407 =head2 _koha_delete_biblioitems
3408
3409   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3410
3411 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3412
3413 C<$dbh> - the database handle
3414 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3415
3416 =cut
3417
3418 # FIXME: add error handling
3419
3420 sub _koha_delete_biblioitems {
3421     my ( $dbh, $biblioitemnumber ) = @_;
3422
3423     # get all the data for this biblioitem
3424     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3425     $sth->execute($biblioitemnumber);
3426
3427     if ( my $data = $sth->fetchrow_hashref ) {
3428
3429         # save the record in deletedbiblioitems
3430         # find the fields to save
3431         my $query = "INSERT INTO deletedbiblioitems SET ";
3432         my @bind  = ();
3433         foreach my $temp ( keys %$data ) {
3434             $query .= "$temp = ?,";
3435             push( @bind, $data->{$temp} );
3436         }
3437
3438         # replace the last , by ",?)"
3439         $query =~ s/\,$//;
3440         my $bkup_sth = $dbh->prepare($query);
3441         $bkup_sth->execute(@bind);
3442         $bkup_sth->finish;
3443
3444         # delete the biblioitem
3445         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3446         $sth2->execute($biblioitemnumber);
3447         # update the timestamp (Bugzilla 7146)
3448         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3449         $sth2->execute($biblioitemnumber);
3450         $sth2->finish;
3451     }
3452     $sth->finish;
3453     return;
3454 }
3455
3456 =head1 UNEXPORTED FUNCTIONS
3457
3458 =head2 ModBiblioMarc
3459
3460   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3461
3462 Add MARC data for a biblio to koha
3463
3464 Function exported, but should NOT be used, unless you really know what you're doing
3465
3466 =cut
3467
3468 sub ModBiblioMarc {
3469     # pass the MARC::Record to this function, and it will create the records in
3470     # the marc field
3471     my ( $record, $biblionumber, $frameworkcode ) = @_;
3472     if ( !$record ) {
3473         carp 'ModBiblioMarc passed an undefined record';
3474         return;
3475     }
3476
3477     # Clone record as it gets modified
3478     $record = $record->clone();
3479     my $dbh    = C4::Context->dbh;
3480     my @fields = $record->fields();
3481     if ( !$frameworkcode ) {
3482         $frameworkcode = "";
3483     }
3484     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3485     $sth->execute( $frameworkcode, $biblionumber );
3486     $sth->finish;
3487     my $encoding = C4::Context->preference("marcflavour");
3488
3489     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3490     if ( $encoding eq "UNIMARC" ) {
3491         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3492         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3493         my $string = $record->subfield( 100, "a" );
3494         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3495             my $f100 = $record->field(100);
3496             $record->delete_field($f100);
3497         } else {
3498             $string = POSIX::strftime( "%Y%m%d", localtime );
3499             $string =~ s/\-//g;
3500             $string = sprintf( "%-*s", 35, $string );
3501             substr ( $string, 22, 3, $defaultlanguage);
3502         }
3503         substr( $string, 25, 3, "y50" );
3504         unless ( $record->subfield( 100, "a" ) ) {
3505             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3506         }
3507     }
3508
3509     #enhancement 5374: update transaction date (005) for marc21/unimarc
3510     if($encoding =~ /MARC21|UNIMARC/) {
3511       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3512         # YY MM DD HH MM SS (update year and month)
3513       my $f005= $record->field('005');
3514       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3515     }
3516
3517     $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3518     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3519     $sth->finish;
3520     ModZebra( $biblionumber, "specialUpdate", "biblioserver", $record );
3521     return $biblionumber;
3522 }
3523
3524 =head2 CountBiblioInOrders
3525
3526     $count = &CountBiblioInOrders( $biblionumber);
3527
3528 This function return count of biblios in orders with $biblionumber
3529
3530 =cut
3531
3532 sub CountBiblioInOrders {
3533  my ($biblionumber) = @_;
3534     my $dbh            = C4::Context->dbh;
3535     my $query          = "SELECT count(*)
3536           FROM  aqorders
3537           WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3538     my $sth = $dbh->prepare($query);
3539     $sth->execute($biblionumber);
3540     my $count = $sth->fetchrow;
3541     return ($count);
3542 }
3543
3544 =head2 GetSubscriptionsId
3545
3546     $subscriptions = &GetSubscriptionsId($biblionumber);
3547
3548 This function return an array of subscriptionid with $biblionumber
3549
3550 =cut
3551
3552 sub GetSubscriptionsId {
3553  my ($biblionumber) = @_;
3554     my $dbh            = C4::Context->dbh;
3555     my $query          = "SELECT subscriptionid
3556           FROM  subscription
3557           WHERE biblionumber=?";
3558     my $sth = $dbh->prepare($query);
3559     $sth->execute($biblionumber);
3560     my @subscriptions = $sth->fetchrow_array;
3561     return (@subscriptions);
3562 }
3563
3564 =head2 GetHolds
3565
3566     $holds = &GetHolds($biblionumber);
3567
3568 This function return the count of holds with $biblionumber
3569
3570 =cut
3571
3572 sub GetHolds {
3573  my ($biblionumber) = @_;
3574     my $dbh            = C4::Context->dbh;
3575     my $query          = "SELECT count(*)
3576           FROM  reserves
3577           WHERE biblionumber=?";
3578     my $sth = $dbh->prepare($query);
3579     $sth->execute($biblionumber);
3580     my $holds = $sth->fetchrow;
3581     return ($holds);
3582 }
3583
3584 =head2 prepare_host_field
3585
3586 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3587 Generate the host item entry for an analytic child entry
3588
3589 =cut
3590
3591 sub prepare_host_field {
3592     my ( $hostbiblio, $marcflavour ) = @_;
3593     $marcflavour ||= C4::Context->preference('marcflavour');
3594     my $host = GetMarcBiblio($hostbiblio);
3595     # unfortunately as_string does not 'do the right thing'
3596     # if field returns undef
3597     my %sfd;
3598     my $field;
3599     my $host_field;
3600     if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3601         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3602             my $s = $field->as_string('ab');
3603             if ($s) {
3604                 $sfd{a} = $s;
3605             }
3606         }
3607         if ( $field = $host->field('245') ) {
3608             my $s = $field->as_string('a');
3609             if ($s) {
3610                 $sfd{t} = $s;
3611             }
3612         }
3613         if ( $field = $host->field('260') ) {
3614             my $s = $field->as_string('abc');
3615             if ($s) {
3616                 $sfd{d} = $s;
3617             }
3618         }
3619         if ( $field = $host->field('240') ) {
3620             my $s = $field->as_string();
3621             if ($s) {
3622                 $sfd{b} = $s;
3623             }
3624         }
3625         if ( $field = $host->field('022') ) {
3626             my $s = $field->as_string('a');
3627             if ($s) {
3628                 $sfd{x} = $s;
3629             }
3630         }
3631         if ( $field = $host->field('020') ) {
3632             my $s = $field->as_string('a');
3633             if ($s) {
3634                 $sfd{z} = $s;
3635             }
3636         }
3637         if ( $field = $host->field('001') ) {
3638             $sfd{w} = $field->data(),;
3639         }
3640         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3641         return $host_field;
3642     }
3643     elsif ( $marcflavour eq 'UNIMARC' ) {
3644         #author
3645         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3646             my $s = $field->as_string('ab');
3647             if ($s) {
3648                 $sfd{a} = $s;
3649             }
3650         }
3651         #title
3652         if ( $field = $host->field('200') ) {
3653             my $s = $field->as_string('a');
3654             if ($s) {
3655                 $sfd{t} = $s;
3656             }
3657         }
3658         #place of publicaton
3659         if ( $field = $host->field('210') ) {
3660             my $s = $field->as_string('a');
3661             if ($s) {
3662                 $sfd{c} = $s;
3663             }
3664         }
3665         #date of publication
3666         if ( $field = $host->field('210') ) {
3667             my $s = $field->as_string('d');
3668             if ($s) {
3669                 $sfd{d} = $s;
3670             }
3671         }
3672         #edition statement
3673         if ( $field = $host->field('205') ) {
3674             my $s = $field->as_string();
3675             if ($s) {
3676                 $sfd{e} = $s;
3677             }
3678         }
3679         #URL
3680         if ( $field = $host->field('856') ) {
3681             my $s = $field->as_string('u');
3682             if ($s) {
3683                 $sfd{u} = $s;
3684             }
3685         }
3686         #ISSN
3687         if ( $field = $host->field('011') ) {
3688             my $s = $field->as_string('a');
3689             if ($s) {
3690                 $sfd{x} = $s;
3691             }
3692         }
3693         #ISBN
3694         if ( $field = $host->field('010') ) {
3695             my $s = $field->as_string('a');
3696             if ($s) {
3697                 $sfd{y} = $s;
3698             }
3699         }
3700         if ( $field = $host->field('001') ) {
3701             $sfd{0} = $field->data(),;
3702         }
3703         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3704         return $host_field;
3705     }
3706     return;
3707 }
3708
3709
3710 =head2 UpdateTotalIssues
3711
3712   UpdateTotalIssues($biblionumber, $increase, [$value])
3713
3714 Update the total issue count for a particular bib record.
3715
3716 =over 4
3717
3718 =item C<$biblionumber> is the biblionumber of the bib to update
3719
3720 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3721
3722 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3723
3724 =back
3725
3726 =cut
3727
3728 sub UpdateTotalIssues {
3729     my ($biblionumber, $increase, $value) = @_;
3730     my $totalissues;
3731
3732     my $record = GetMarcBiblio($biblionumber);
3733     unless ($record) {
3734         carp "UpdateTotalIssues could not get biblio record";
3735         return;
3736     }
3737     my $data = GetBiblioData($biblionumber);
3738     unless ($data) {
3739         carp "UpdateTotalIssues could not get datas of biblio";
3740         return;
3741     }
3742     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
3743     unless ($totalissuestag) {
3744         return 1; # There is nothing to do
3745     }
3746
3747     if (defined $value) {
3748         $totalissues = $value;
3749     } else {
3750         $totalissues = $data->{'totalissues'} + $increase;
3751     }
3752
3753      my $field = $record->field($totalissuestag);
3754      if (defined $field) {
3755          $field->update( $totalissuessubfield => $totalissues );
3756      } else {
3757          $field = MARC::Field->new($totalissuestag, '0', '0',
3758                  $totalissuessubfield => $totalissues);
3759          $record->insert_grouped_field($field);
3760      }
3761
3762      return ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
3763 }
3764
3765 =head2 RemoveAllNsb
3766
3767     &RemoveAllNsb($record);
3768
3769 Removes all nsb/nse chars from a record
3770
3771 =cut
3772
3773 sub RemoveAllNsb {
3774     my $record = shift;
3775     if (!$record) {
3776         carp 'RemoveAllNsb called with undefined record';
3777         return;
3778     }
3779
3780     SetUTF8Flag($record);
3781
3782     foreach my $field ($record->fields()) {
3783         if ($field->is_control_field()) {
3784             $field->update(nsb_clean($field->data()));
3785         } else {
3786             my @subfields = $field->subfields();
3787             my @new_subfields;
3788             foreach my $subfield (@subfields) {
3789                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3790             }
3791             if (scalar(@new_subfields) > 0) {
3792                 my $new_field;
3793                 eval {
3794                     $new_field = MARC::Field->new(
3795                         $field->tag(),
3796                         $field->indicator(1),
3797                         $field->indicator(2),
3798                         @new_subfields
3799                     );
3800                 };
3801                 if ($@) {
3802                     warn "error in RemoveAllNsb : $@";
3803                 } else {
3804                     $field->replace_with($new_field);
3805                 }
3806             }
3807         }
3808     }
3809
3810     return $record;
3811 }
3812
3813 1;
3814
3815
3816 __END__
3817
3818 =head1 AUTHOR
3819
3820 Koha Development Team <http://koha-community.org/>
3821
3822 Paul POULAIN paul.poulain@free.fr
3823
3824 Joshua Ferraro jmf@liblime.com
3825
3826 =cut