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