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