C4/Biblio.pm

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