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