C4/Biblio.pm

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