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