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