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