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