C4/Biblio.pm

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