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