C4/Biblio.pm

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