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