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