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