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