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