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