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