C4/Biblio.pm

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