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(@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 notes are stored in different fields depending on MARC flavour.
1797     MARC21 field 555 gets special attention for the $u subfields.
1798
1799 =cut
1800
1801 sub GetMarcNotes {
1802     my ( $record, $marcflavour ) = @_;
1803     if (!$record) {
1804         carp 'GetMarcNotes called on undefined record';
1805         return;
1806     }
1807
1808     my $scope = $marcflavour eq "UNIMARC"? '3..': '5..';
1809     my @marcnotes;
1810     my %blacklist = map { $_ => 1 }
1811         split( /,/, C4::Context->preference('NotesBlacklist'));
1812     foreach my $field ( $record->field($scope) ) {
1813         my $tag = $field->tag();
1814         next if $blacklist{ $tag };
1815         if( $marcflavour ne 'UNIMARC' && $tag =~ /555/ ) {
1816             # Field 555$u contains URLs
1817             # We first push the regular subfields and all $u's separately
1818             # Leave further actions to the template
1819             push @marcnotes, { marcnote => $field->as_string('abcd') };
1820             foreach my $sub ( $field->subfield('u') ) {
1821                 push @marcnotes, { marcnote => $sub };
1822             }
1823         } else {
1824             push @marcnotes, { marcnote => $field->as_string() };
1825         }
1826     }
1827     return \@marcnotes;
1828 }
1829
1830 =head2 GetMarcSubjects
1831
1832   $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1833
1834 Get all subjects from the MARC record and returns them in an array.
1835 The subjects are stored in different fields depending on MARC flavour
1836
1837 =cut
1838
1839 sub GetMarcSubjects {
1840     my ( $record, $marcflavour ) = @_;
1841     if (!$record) {
1842         carp 'GetMarcSubjects called on undefined record';
1843         return;
1844     }
1845     my ( $mintag, $maxtag, $fields_filter );
1846     if ( $marcflavour eq "UNIMARC" ) {
1847         $mintag = "600";
1848         $maxtag = "611";
1849         $fields_filter = '6..';
1850     } else { # marc21/normarc
1851         $mintag = "600";
1852         $maxtag = "699";
1853         $fields_filter = '6..';
1854     }
1855
1856     my @marcsubjects;
1857
1858     my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1859     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1860
1861     foreach my $field ( $record->field($fields_filter) ) {
1862         next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1863         my @subfields_loop;
1864         my @subfields = $field->subfields();
1865         my @link_loop;
1866
1867         # if there is an authority link, build the links with an= subfield9
1868         my $subfield9 = $field->subfield('9');
1869         my $authoritylink;
1870         if ($subfield9) {
1871             my $linkvalue = $subfield9;
1872             $linkvalue =~ s/(\(|\))//g;
1873             @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1874             $authoritylink = $linkvalue
1875         }
1876
1877         # other subfields
1878         for my $subject_subfield (@subfields) {
1879             next if ( $subject_subfield->[0] eq '9' );
1880
1881             # don't load unimarc subfields 3,4,5
1882             next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1883             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1884             next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1885
1886             my $code      = $subject_subfield->[0];
1887             my $value     = $subject_subfield->[1];
1888             my $linkvalue = $value;
1889             $linkvalue =~ s/(\(|\))//g;
1890             # if no authority link, build a search query
1891             unless ($subfield9) {
1892                 push @link_loop, {
1893                     limit    => $subject_limit,
1894                     'link'   => $linkvalue,
1895                     operator => (scalar @link_loop) ? ' and ' : undef
1896                 };
1897             }
1898             my @this_link_loop = @link_loop;
1899             # do not display $0
1900             unless ( $code eq '0' ) {
1901                 push @subfields_loop, {
1902                     code      => $code,
1903                     value     => $value,
1904                     link_loop => \@this_link_loop,
1905                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
1906                 };
1907             }
1908         }
1909
1910         push @marcsubjects, {
1911             MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1912             authoritylink => $authoritylink,
1913         };
1914
1915     }
1916     return \@marcsubjects;
1917 }    #end getMARCsubjects
1918
1919 =head2 GetMarcAuthors
1920
1921   authors = GetMarcAuthors($record,$marcflavour);
1922
1923 Get all authors from the MARC record and returns them in an array.
1924 The authors are stored in different fields depending on MARC flavour
1925
1926 =cut
1927
1928 sub GetMarcAuthors {
1929     my ( $record, $marcflavour ) = @_;
1930     if (!$record) {
1931         carp 'GetMarcAuthors called on undefined record';
1932         return;
1933     }
1934     my ( $mintag, $maxtag, $fields_filter );
1935
1936     # tagslib useful for UNIMARC author reponsabilities
1937     my $tagslib =
1938       &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.
1939     if ( $marcflavour eq "UNIMARC" ) {
1940         $mintag = "700";
1941         $maxtag = "712";
1942         $fields_filter = '7..';
1943     } else { # marc21/normarc
1944         $mintag = "700";
1945         $maxtag = "720";
1946         $fields_filter = '7..';
1947     }
1948
1949     my @marcauthors;
1950     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
1951
1952     foreach my $field ( $record->field($fields_filter) ) {
1953         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1954         my @subfields_loop;
1955         my @link_loop;
1956         my @subfields  = $field->subfields();
1957         my $count_auth = 0;
1958
1959         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1960         my $subfield9 = $field->subfield('9');
1961         if ($subfield9) {
1962             my $linkvalue = $subfield9;
1963             $linkvalue =~ s/(\(|\))//g;
1964             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1965         }
1966
1967         # other subfields
1968         my $unimarc3;
1969         for my $authors_subfield (@subfields) {
1970             next if ( $authors_subfield->[0] eq '9' );
1971
1972             # unimarc3 contains the $3 of the author for UNIMARC.
1973             # For french academic libraries, it's the "ppn", and it's required for idref webservice
1974             $unimarc3 = $authors_subfield->[1] if $marcflavour eq 'UNIMARC' and $authors_subfield->[0] =~ /3/;
1975
1976             # don't load unimarc subfields 3, 5
1977             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1978
1979             my $code = $authors_subfield->[0];
1980             my $value        = $authors_subfield->[1];
1981             my $linkvalue    = $value;
1982             $linkvalue =~ s/(\(|\))//g;
1983             # UNIMARC author responsibility
1984             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1985                 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1986                 $linkvalue = "($value)";
1987             }
1988             # if no authority link, build a search query
1989             unless ($subfield9) {
1990                 push @link_loop, {
1991                     limit    => 'au',
1992                     'link'   => $linkvalue,
1993                     operator => (scalar @link_loop) ? ' and ' : undef
1994                 };
1995             }
1996             my @this_link_loop = @link_loop;
1997             # do not display $0
1998             unless ( $code eq '0') {
1999                 push @subfields_loop, {
2000                     tag       => $field->tag(),
2001                     code      => $code,
2002                     value     => $value,
2003                     link_loop => \@this_link_loop,
2004                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
2005                 };
2006             }
2007         }
2008         push @marcauthors, {
2009             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
2010             authoritylink => $subfield9,
2011             unimarc3 => $unimarc3
2012         };
2013     }
2014     return \@marcauthors;
2015 }
2016
2017 =head2 GetMarcUrls
2018
2019   $marcurls = GetMarcUrls($record,$marcflavour);
2020
2021 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
2022 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
2023
2024 =cut
2025
2026 sub GetMarcUrls {
2027     my ( $record, $marcflavour ) = @_;
2028     if (!$record) {
2029         carp 'GetMarcUrls called on undefined record';
2030         return;
2031     }
2032
2033     my @marcurls;
2034     for my $field ( $record->field('856') ) {
2035         my @notes;
2036         for my $note ( $field->subfield('z') ) {
2037             push @notes, { note => $note };
2038         }
2039         my @urls = $field->subfield('u');
2040         foreach my $url (@urls) {
2041             my $marcurl;
2042             if ( $marcflavour eq 'MARC21' ) {
2043                 my $s3   = $field->subfield('3');
2044                 my $link = $field->subfield('y');
2045                 unless ( $url =~ /^\w+:/ ) {
2046                     if ( $field->indicator(1) eq '7' ) {
2047                         $url = $field->subfield('2') . "://" . $url;
2048                     } elsif ( $field->indicator(1) eq '1' ) {
2049                         $url = 'ftp://' . $url;
2050                     } else {
2051
2052                         #  properly, this should be if ind1=4,
2053                         #  however we will assume http protocol since we're building a link.
2054                         $url = 'http://' . $url;
2055                     }
2056                 }
2057
2058                 # TODO handle ind 2 (relationship)
2059                 $marcurl = {
2060                     MARCURL => $url,
2061                     notes   => \@notes,
2062                 };
2063                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
2064                 $marcurl->{'part'} = $s3 if ($link);
2065                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
2066             } else {
2067                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
2068                 $marcurl->{'MARCURL'} = $url;
2069             }
2070             push @marcurls, $marcurl;
2071         }
2072     }
2073     return \@marcurls;
2074 }
2075
2076 =head2 GetMarcSeries
2077
2078   $marcseriesarray = GetMarcSeries($record,$marcflavour);
2079
2080 Get all series from the MARC record and returns them in an array.
2081 The series are stored in different fields depending on MARC flavour
2082
2083 =cut
2084
2085 sub GetMarcSeries {
2086     my ( $record, $marcflavour ) = @_;
2087     if (!$record) {
2088         carp 'GetMarcSeries called on undefined record';
2089         return;
2090     }
2091
2092     my ( $mintag, $maxtag, $fields_filter );
2093     if ( $marcflavour eq "UNIMARC" ) {
2094         $mintag = "225";
2095         $maxtag = "225";
2096         $fields_filter = '2..';
2097     } else {    # marc21/normarc
2098         $mintag = "440";
2099         $maxtag = "490";
2100         $fields_filter = '4..';
2101     }
2102
2103     my @marcseries;
2104     my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
2105
2106     foreach my $field ( $record->field($fields_filter) ) {
2107         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
2108         my @subfields_loop;
2109         my @subfields = $field->subfields();
2110         my @link_loop;
2111
2112         for my $series_subfield (@subfields) {
2113
2114             # ignore $9, used for authority link
2115             next if ( $series_subfield->[0] eq '9' );
2116
2117             my $volume_number;
2118             my $code      = $series_subfield->[0];
2119             my $value     = $series_subfield->[1];
2120             my $linkvalue = $value;
2121             $linkvalue =~ s/(\(|\))//g;
2122
2123             # see if this is an instance of a volume
2124             if ( $code eq 'v' ) {
2125                 $volume_number = 1;
2126             }
2127
2128             push @link_loop, {
2129                 'link' => $linkvalue,
2130                 operator => (scalar @link_loop) ? ' and ' : undef
2131             };
2132
2133             if ($volume_number) {
2134                 push @subfields_loop, { volumenum => $value };
2135             } else {
2136                 push @subfields_loop, {
2137                     code      => $code,
2138                     value     => $value,
2139                     link_loop => \@link_loop,
2140                     separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
2141                     volumenum => $volume_number,
2142                 }
2143             }
2144         }
2145         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2146
2147     }
2148     return \@marcseries;
2149 }    #end getMARCseriess
2150
2151 =head2 GetMarcHosts
2152
2153   $marchostsarray = GetMarcHosts($record,$marcflavour);
2154
2155 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2156
2157 =cut
2158
2159 sub GetMarcHosts {
2160     my ( $record, $marcflavour ) = @_;
2161     if (!$record) {
2162         carp 'GetMarcHosts called on undefined record';
2163         return;
2164     }
2165
2166     my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2167     $marcflavour ||="MARC21";
2168     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2169         $tag = "773";
2170         $title_subf = "t";
2171         $bibnumber_subf ="0";
2172         $itemnumber_subf='9';
2173     }
2174     elsif ($marcflavour eq "UNIMARC") {
2175         $tag = "461";
2176         $title_subf = "t";
2177         $bibnumber_subf ="0";
2178         $itemnumber_subf='9';
2179     };
2180
2181     my @marchosts;
2182
2183     foreach my $field ( $record->field($tag)) {
2184
2185         my @fields_loop;
2186
2187         my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2188         my $hosttitle = $field->subfield($title_subf);
2189         my $hostitemnumber=$field->subfield($itemnumber_subf);
2190         push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2191         push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2192
2193         }
2194     my $marchostsarray = \@marchosts;
2195     return $marchostsarray;
2196 }
2197
2198 =head2 GetFrameworkCode
2199
2200   $frameworkcode = GetFrameworkCode( $biblionumber )
2201
2202 =cut
2203
2204 sub GetFrameworkCode {
2205     my ($biblionumber) = @_;
2206     my $dbh            = C4::Context->dbh;
2207     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2208     $sth->execute($biblionumber);
2209     my ($frameworkcode) = $sth->fetchrow;
2210     return $frameworkcode;
2211 }
2212
2213 =head2 TransformKohaToMarc
2214
2215     $record = TransformKohaToMarc( $hash )
2216
2217 This function builds partial MARC::Record from a hash
2218 Hash entries can be from biblio or biblioitems.
2219
2220 This function is called in acquisition module, to create a basic catalogue
2221 entry from user entry
2222
2223 =cut
2224
2225
2226 sub TransformKohaToMarc {
2227     my $hash = shift;
2228     my $record = MARC::Record->new();
2229     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2230     my $db_to_marc = C4::Context->marcfromkohafield;
2231     my $tag_hr = {};
2232     while ( my ($name, $value) = each %$hash ) {
2233         next unless my $dtm = $db_to_marc->{''}->{$name};
2234         next unless ( scalar( @$dtm ) );
2235         my ($tag, $letter) = @$dtm;
2236         $tag .= '';
2237         foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2238             next if $value eq '';
2239             $tag_hr->{$tag} //= [];
2240             push @{$tag_hr->{$tag}}, [($letter, $value)];
2241         }
2242     }
2243     foreach my $tag (sort keys %$tag_hr) {
2244         my @sfl = @{$tag_hr->{$tag}};
2245         @sfl = sort { $a->[0] cmp $b->[0]; } @sfl;
2246         @sfl = map { @{$_}; } @sfl;
2247         $record->insert_fields_ordered(
2248             MARC::Field->new($tag, " ", " ", @sfl)
2249         );
2250     }
2251     return $record;
2252 }
2253
2254 =head2 PrepHostMarcField
2255
2256     $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2257
2258 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2259
2260 =cut
2261
2262 sub PrepHostMarcField {
2263     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2264     $marcflavour ||="MARC21";
2265
2266     require C4::Items;
2267     my $hostrecord = GetMarcBiblio($hostbiblionumber);
2268         my $item = C4::Items::GetItem($hostitemnumber);
2269
2270         my $hostmarcfield;
2271     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2272
2273         #main entry
2274         my $mainentry;
2275         if ($hostrecord->subfield('100','a')){
2276             $mainentry = $hostrecord->subfield('100','a');
2277         } elsif ($hostrecord->subfield('110','a')){
2278             $mainentry = $hostrecord->subfield('110','a');
2279         } else {
2280             $mainentry = $hostrecord->subfield('111','a');
2281         }
2282
2283         # qualification info
2284         my $qualinfo;
2285         if (my $field260 = $hostrecord->field('260')){
2286             $qualinfo =  $field260->as_string( 'abc' );
2287         }
2288
2289
2290         #other fields
2291         my $ed = $hostrecord->subfield('250','a');
2292         my $barcode = $item->{'barcode'};
2293         my $title = $hostrecord->subfield('245','a');
2294
2295         # record control number, 001 with 003 and prefix
2296         my $recctrlno;
2297         if ($hostrecord->field('001')){
2298             $recctrlno = $hostrecord->field('001')->data();
2299             if ($hostrecord->field('003')){
2300                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2301             }
2302         }
2303
2304         # issn/isbn
2305         my $issn = $hostrecord->subfield('022','a');
2306         my $isbn = $hostrecord->subfield('020','a');
2307
2308
2309         $hostmarcfield = MARC::Field->new(
2310                 773, '0', '',
2311                 '0' => $hostbiblionumber,
2312                 '9' => $hostitemnumber,
2313                 'a' => $mainentry,
2314                 'b' => $ed,
2315                 'd' => $qualinfo,
2316                 'o' => $barcode,
2317                 't' => $title,
2318                 'w' => $recctrlno,
2319                 'x' => $issn,
2320                 'z' => $isbn
2321                 );
2322     } elsif ($marcflavour eq "UNIMARC") {
2323         $hostmarcfield = MARC::Field->new(
2324             461, '', '',
2325             '0' => $hostbiblionumber,
2326             't' => $hostrecord->subfield('200','a'),
2327             '9' => $hostitemnumber
2328         );
2329     };
2330
2331     return $hostmarcfield;
2332 }
2333
2334 =head2 TransformHtmlToXml
2335
2336   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2337                              $ind_tag, $auth_type )
2338
2339 $auth_type contains :
2340
2341 =over
2342
2343 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2344
2345 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2346
2347 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2348
2349 =back
2350
2351 =cut
2352
2353 sub TransformHtmlToXml {
2354     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2355     # NOTE: The parameter $ind_tag is NOT USED -- BZ 11247
2356
2357     my $xml = MARC::File::XML::header('UTF-8');
2358     $xml .= "<record>\n";
2359     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2360     MARC::File::XML->default_record_format($auth_type);
2361
2362     # in UNIMARC, field 100 contains the encoding
2363     # check that there is one, otherwise the
2364     # MARC::Record->new_from_xml will fail (and Koha will die)
2365     my $unimarc_and_100_exist = 0;
2366     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
2367     my $prevvalue;
2368     my $prevtag = -1;
2369     my $first   = 1;
2370     my $j       = -1;
2371     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2372
2373         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2374
2375             # if we have a 100 field and it's values are not correct, skip them.
2376             # if we don't have any valid 100 field, we will create a default one at the end
2377             my $enc = substr( @$values[$i], 26, 2 );
2378             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2379                 $unimarc_and_100_exist = 1;
2380             } else {
2381                 next;
2382             }
2383         }
2384         @$values[$i] =~ s/&/&amp;/g;
2385         @$values[$i] =~ s/</&lt;/g;
2386         @$values[$i] =~ s/>/&gt;/g;
2387         @$values[$i] =~ s/"/&quot;/g;
2388         @$values[$i] =~ s/'/&apos;/g;
2389
2390         if ( ( @$tags[$i] ne $prevtag ) ) {
2391             $j++ unless ( @$tags[$i] eq "" );
2392             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2393             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2394             my $ind1       = _default_ind_to_space($indicator1);
2395             my $ind2;
2396             if ( @$indicator[$j] ) {
2397                 $ind2 = _default_ind_to_space($indicator2);
2398             } else {
2399                 warn "Indicator in @$tags[$i] is empty";
2400                 $ind2 = " ";
2401             }
2402             if ( !$first ) {
2403                 $xml .= "</datafield>\n";
2404                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2405                     && ( @$values[$i] ne "" ) ) {
2406                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2407                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2408                     $first = 0;
2409                 } else {
2410                     $first = 1;
2411                 }
2412             } else {
2413                 if ( @$values[$i] ne "" ) {
2414
2415                     # leader
2416                     if ( @$tags[$i] eq "000" ) {
2417                         $xml .= "<leader>@$values[$i]</leader>\n";
2418                         $first = 1;
2419
2420                         # rest of the fixed fields
2421                     } elsif ( @$tags[$i] < 10 ) {
2422                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2423                         $first = 1;
2424                     } else {
2425                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2426                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2427                         $first = 0;
2428                     }
2429                 }
2430             }
2431         } else {    # @$tags[$i] eq $prevtag
2432             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2433             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2434             my $ind1       = _default_ind_to_space($indicator1);
2435             my $ind2;
2436             if ( @$indicator[$j] ) {
2437                 $ind2 = _default_ind_to_space($indicator2);
2438             } else {
2439                 warn "Indicator in @$tags[$i] is empty";
2440                 $ind2 = " ";
2441             }
2442             if ( @$values[$i] eq "" ) {
2443             } else {
2444                 if ($first) {
2445                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2446                     $first = 0;
2447                 }
2448                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2449             }
2450         }
2451         $prevtag = @$tags[$i];
2452     }
2453     $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2454     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2455
2456         #     warn "SETTING 100 for $auth_type";
2457         my $string = strftime( "%Y%m%d", localtime(time) );
2458
2459         # set 50 to position 26 is biblios, 13 if authorities
2460         my $pos = 26;
2461         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2462         $string = sprintf( "%-*s", 35, $string );
2463         substr( $string, $pos, 6, "50" );
2464         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2465         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2466         $xml .= "</datafield>\n";
2467     }
2468     $xml .= "</record>\n";
2469     $xml .= MARC::File::XML::footer();
2470     return $xml;
2471 }
2472
2473 =head2 _default_ind_to_space
2474
2475 Passed what should be an indicator returns a space
2476 if its undefined or zero length
2477
2478 =cut
2479
2480 sub _default_ind_to_space {
2481     my $s = shift;
2482     if ( !defined $s || $s eq q{} ) {
2483         return ' ';
2484     }
2485     return $s;
2486 }
2487
2488 =head2 TransformHtmlToMarc
2489
2490     L<$record> = TransformHtmlToMarc(L<$cgi>)
2491     L<$cgi> is the CGI object which containts the values for subfields
2492     {
2493         'tag_010_indicator1_531951' ,
2494         'tag_010_indicator2_531951' ,
2495         'tag_010_code_a_531951_145735' ,
2496         'tag_010_subfield_a_531951_145735' ,
2497         'tag_200_indicator1_873510' ,
2498         'tag_200_indicator2_873510' ,
2499         'tag_200_code_a_873510_673465' ,
2500         'tag_200_subfield_a_873510_673465' ,
2501         'tag_200_code_b_873510_704318' ,
2502         'tag_200_subfield_b_873510_704318' ,
2503         'tag_200_code_e_873510_280822' ,
2504         'tag_200_subfield_e_873510_280822' ,
2505         'tag_200_code_f_873510_110730' ,
2506         'tag_200_subfield_f_873510_110730' ,
2507     }
2508     L<$record> is the MARC::Record object.
2509
2510 =cut
2511
2512 sub TransformHtmlToMarc {
2513     my ($cgi, $isbiblio) = @_;
2514
2515     my @params = $cgi->param();
2516
2517     # explicitly turn on the UTF-8 flag for all
2518     # 'tag_' parameters to avoid incorrect character
2519     # conversion later on
2520     my $cgi_params = $cgi->Vars;
2521     foreach my $param_name ( keys %$cgi_params ) {
2522         if ( $param_name =~ /^tag_/ ) {
2523             my $param_value = $cgi_params->{$param_name};
2524             unless ( Encode::is_utf8( $param_value ) ) {
2525                 $cgi_params->{$param_name} = Encode::decode('UTF-8', $param_value );
2526             }
2527         }
2528     }
2529
2530     # creating a new record
2531     my $record = MARC::Record->new();
2532     my @fields;
2533     my ($biblionumbertagfield, $biblionumbertagsubfield) = (-1, -1);
2534     ($biblionumbertagfield, $biblionumbertagsubfield) =
2535         &GetMarcFromKohaField( "biblio.biblionumber", '' ) if $isbiblio;
2536 #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!
2537     for (my $i = 0; $params[$i]; $i++ ) {    # browse all CGI params
2538         my $param    = $params[$i];
2539         my $newfield = 0;
2540
2541         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2542         if ( $param eq 'biblionumber' ) {
2543             if ( $biblionumbertagfield < 10 ) {
2544                 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2545             } else {
2546                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2547             }
2548             push @fields, $newfield if ($newfield);
2549         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2550             my $tag = $1;
2551
2552             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2553             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2554             $newfield = 0;
2555             my $j = $i + 2;
2556
2557             if ( $tag < 10 ) {                              # no code for theses fields
2558                                                             # in MARC editor, 000 contains the leader.
2559                 next if $tag == $biblionumbertagfield;
2560                 if ( $tag eq '000' ) {
2561                     # Force a fake leader even if not provided to avoid crashing
2562                     # during decoding MARC record containing UTF-8 characters
2563                     $record->leader(
2564                         length( $cgi->param($params[$j+1]) ) == 24
2565                         ? $cgi->param( $params[ $j + 1 ] )
2566                         : '     nam a22        4500'
2567                         )
2568                     ;
2569                     # between 001 and 009 (included)
2570                 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2571                     $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2572                 }
2573
2574                 # > 009, deal with subfields
2575             } else {
2576                 # browse subfields for this tag (reason for _code_ match)
2577                 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2578                     last unless defined $params[$j+1];
2579                     $j += 2 and next
2580                         if $tag == $biblionumbertagfield and
2581                            $cgi->param($params[$j]) eq $biblionumbertagsubfield;
2582                     #if next param ne subfield, then it was probably empty
2583                     #try next param by incrementing j
2584                     if($params[$j+1]!~/_subfield_/) {$j++; next; }
2585                     my $fval= $cgi->param($params[$j+1]);
2586                     #check if subfield value not empty and field exists
2587                     if($fval ne '' && $newfield) {
2588                         $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
2589                     }
2590                     elsif($fval ne '') {
2591                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
2592                     }
2593                     $j += 2;
2594                 } #end-of-while
2595                 $i= $j-1; #update i for outer loop accordingly
2596             }
2597             push @fields, $newfield if ($newfield);
2598         }
2599     }
2600
2601     $record->append_fields(@fields);
2602     return $record;
2603 }
2604
2605 # cache inverted MARC field map
2606 our $inverted_field_map;
2607
2608 =head2 TransformMarcToKoha
2609
2610   $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2611
2612 Extract data from a MARC bib record into a hashref representing
2613 Koha biblio, biblioitems, and items fields.
2614
2615 If passed an undefined record will log the error and return an empty
2616 hash_ref
2617
2618 =cut
2619
2620 sub TransformMarcToKoha {
2621     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2622
2623     my $result = {};
2624     if (!defined $record) {
2625         carp('TransformMarcToKoha called with undefined record');
2626         return $result;
2627     }
2628     $limit_table = $limit_table || 0;
2629     $frameworkcode = '' unless defined $frameworkcode;
2630
2631     unless ( defined $inverted_field_map ) {
2632         $inverted_field_map = _get_inverted_marc_field_map();
2633     }
2634
2635     my %tables = ();
2636     if ( defined $limit_table && $limit_table eq 'items' ) {
2637         $tables{'items'} = 1;
2638     } else {
2639         $tables{'items'}       = 1;
2640         $tables{'biblio'}      = 1;
2641         $tables{'biblioitems'} = 1;
2642     }
2643
2644     # traverse through record
2645   MARCFIELD: foreach my $field ( $record->fields() ) {
2646         my $tag = $field->tag();
2647         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2648         if ( $field->is_control_field() ) {
2649             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2650           ENTRY: foreach my $entry ( @{$kohafields} ) {
2651                 my ( $subfield, $table, $column ) = @{$entry};
2652                 next ENTRY unless exists $tables{$table};
2653                 my $key = _disambiguate( $table, $column );
2654                 if ( $result->{$key} ) {
2655                     unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2656                         $result->{$key} .= " | " . $field->data();
2657                     }
2658                 } else {
2659                     $result->{$key} = $field->data();
2660                 }
2661             }
2662         } else {
2663
2664             # deal with subfields
2665           MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2666                 my $code = $sf->[0];
2667                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2668                 my $value = $sf->[1];
2669               SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2670                     my ( $table, $column ) = @{$entry};
2671                     next SFENTRY unless exists $tables{$table};
2672                     my $key = _disambiguate( $table, $column );
2673                     if ( $result->{$key} ) {
2674                         unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2675                             $result->{$key} .= " | " . $value;
2676                         }
2677                     } else {
2678                         $result->{$key} = $value;
2679                     }
2680                 }
2681             }
2682         }
2683     }
2684
2685     # modify copyrightdate to keep only the 1st year found
2686     if ( exists $result->{'copyrightdate'} ) {
2687         my $temp = $result->{'copyrightdate'};
2688         $temp =~ m/c(\d\d\d\d)/;
2689         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2690             $result->{'copyrightdate'} = $1;
2691         } else {                                       # if no cYYYY, get the 1st date.
2692             $temp =~ m/(\d\d\d\d)/;
2693             $result->{'copyrightdate'} = $1;
2694         }
2695     }
2696
2697     # modify publicationyear to keep only the 1st year found
2698     if ( exists $result->{'publicationyear'} ) {
2699         my $temp = $result->{'publicationyear'};
2700         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2701             $result->{'publicationyear'} = $1;
2702         } else {                                       # if no cYYYY, get the 1st date.
2703             $temp =~ m/(\d\d\d\d)/;
2704             $result->{'publicationyear'} = $1;
2705         }
2706     }
2707
2708     return $result;
2709 }
2710
2711 sub _get_inverted_marc_field_map {
2712     my $field_map = {};
2713     my $relations = C4::Context->marcfromkohafield;
2714
2715     foreach my $frameworkcode ( keys %{$relations} ) {
2716         foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2717             next unless @{ $relations->{$frameworkcode}->{$kohafield} };    # not all columns are mapped to MARC tag & subfield
2718             my $tag      = $relations->{$frameworkcode}->{$kohafield}->[0];
2719             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2720             my ( $table, $column ) = split /[.]/, $kohafield, 2;
2721             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2722             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2723         }
2724     }
2725     return $field_map;
2726 }
2727
2728 =head2 _disambiguate
2729
2730   $newkey = _disambiguate($table, $field);
2731
2732 This is a temporary hack to distinguish between the
2733 following sets of columns when using TransformMarcToKoha.
2734
2735   items.cn_source & biblioitems.cn_source
2736   items.cn_sort & biblioitems.cn_sort
2737
2738 Columns that are currently NOT distinguished (FIXME
2739 due to lack of time to fully test) are:
2740
2741   biblio.notes and biblioitems.notes
2742   biblionumber
2743   timestamp
2744   biblioitemnumber
2745
2746 FIXME - this is necessary because prefixing each column
2747 name with the table name would require changing lots
2748 of code and templates, and exposing more of the DB
2749 structure than is good to the UI templates, particularly
2750 since biblio and bibloitems may well merge in a future
2751 version.  In the future, it would also be good to
2752 separate DB access and UI presentation field names
2753 more.
2754
2755 =cut
2756
2757 sub CountItemsIssued {
2758     my ($biblionumber) = @_;
2759     my $dbh            = C4::Context->dbh;
2760     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2761     $sth->execute($biblionumber);
2762     my $row = $sth->fetchrow_hashref();
2763     return $row->{'issuedCount'};
2764 }
2765
2766 sub _disambiguate {
2767     my ( $table, $column ) = @_;
2768     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2769         return $table . '.' . $column;
2770     } else {
2771         return $column;
2772     }
2773
2774 }
2775
2776 =head2 get_koha_field_from_marc
2777
2778   $result->{_disambiguate($table, $field)} =
2779      get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2780
2781 Internal function to map data from the MARC record to a specific non-MARC field.
2782 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2783
2784 =cut
2785
2786 sub get_koha_field_from_marc {
2787     my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2788     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2789     my $kohafield;
2790     foreach my $field ( $record->field($tagfield) ) {
2791         if ( $field->tag() < 10 ) {
2792             if ($kohafield) {
2793                 $kohafield .= " | " . $field->data();
2794             } else {
2795                 $kohafield = $field->data();
2796             }
2797         } else {
2798             if ( $field->subfields ) {
2799                 my @subfields = $field->subfields();
2800                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2801                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2802                         if ($kohafield) {
2803                             $kohafield .= " | " . $subfields[$subfieldcount][1];
2804                         } else {
2805                             $kohafield = $subfields[$subfieldcount][1];
2806                         }
2807                     }
2808                 }
2809             }
2810         }
2811     }
2812     return $kohafield;
2813 }
2814
2815 =head2 TransformMarcToKohaOneField
2816
2817   $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2818
2819 =cut
2820
2821 sub TransformMarcToKohaOneField {
2822
2823     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2824     # only the 1st will be retrieved...
2825     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2826     my $res = "";
2827     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2828     foreach my $field ( $record->field($tagfield) ) {
2829         if ( $field->tag() < 10 ) {
2830             if ( $result->{$kohafield} ) {
2831                 $result->{$kohafield} .= " | " . $field->data();
2832             } else {
2833                 $result->{$kohafield} = $field->data();
2834             }
2835         } else {
2836             if ( $field->subfields ) {
2837                 my @subfields = $field->subfields();
2838                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2839                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2840                         if ( $result->{$kohafield} ) {
2841                             $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2842                         } else {
2843                             $result->{$kohafield} = $subfields[$subfieldcount][1];
2844                         }
2845                     }
2846                 }
2847             }
2848         }
2849     }
2850     return $result;
2851 }
2852
2853
2854 #"
2855
2856 #
2857 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2858 # at the same time
2859 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2860 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2861 # =head2 ModZebrafiles
2862 #
2863 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2864 #
2865 # =cut
2866 #
2867 # sub ModZebrafiles {
2868 #
2869 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2870 #
2871 #     my $op;
2872 #     my $zebradir =
2873 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2874 #     unless ( opendir( DIR, "$zebradir" ) ) {
2875 #         warn "$zebradir not found";
2876 #         return;
2877 #     }
2878 #     closedir DIR;
2879 #     my $filename = $zebradir . $biblionumber;
2880 #
2881 #     if ($record) {
2882 #         open( OUTPUT, ">", $filename . ".xml" );
2883 #         print OUTPUT $record;
2884 #         close OUTPUT;
2885 #     }
2886 # }
2887
2888 =head2 ModZebra
2889
2890   ModZebra( $biblionumber, $op, $server );
2891
2892 $biblionumber is the biblionumber we want to index
2893
2894 $op is specialUpdate or delete, and is used to know what we want to do
2895
2896 $server is the server that we want to update
2897
2898 =cut
2899
2900 sub ModZebra {
2901 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2902     my ( $biblionumber, $op, $server ) = @_;
2903     my $dbh = C4::Context->dbh;
2904
2905     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2906     # at the same time
2907     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2908     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2909
2910     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2911                      WHERE server = ?
2912                      AND   biblio_auth_number = ?
2913                      AND   operation = ?
2914                      AND   done = 0";
2915     my $check_sth = $dbh->prepare_cached($check_sql);
2916     $check_sth->execute( $server, $biblionumber, $op );
2917     my ($count) = $check_sth->fetchrow_array;
2918     $check_sth->finish();
2919     if ( $count == 0 ) {
2920         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2921         $sth->execute( $biblionumber, $server, $op );
2922         $sth->finish;
2923     }
2924 }
2925
2926
2927 =head2 EmbedItemsInMarcBiblio
2928
2929     EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers, $opac);
2930
2931 Given a MARC::Record object containing a bib record,
2932 modify it to include the items attached to it as 9XX
2933 per the bib's MARC framework.
2934 if $itemnumbers is defined, only specified itemnumbers are embedded.
2935
2936 If $opac is true, then opac-relevant suppressions are included.
2937
2938 =cut
2939
2940 sub EmbedItemsInMarcBiblio {
2941     my ($marc, $biblionumber, $itemnumbers, $opac) = @_;
2942     if ( !$marc ) {
2943         carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2944         return;
2945     }
2946
2947     $itemnumbers = [] unless defined $itemnumbers;
2948
2949     my $frameworkcode = GetFrameworkCode($biblionumber);
2950     _strip_item_fields($marc, $frameworkcode);
2951
2952     # ... and embed the current items
2953     my $dbh = C4::Context->dbh;
2954     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2955     $sth->execute($biblionumber);
2956     my @item_fields;
2957     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2958     my @items;
2959     my $opachiddenitems = $opac
2960       && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2961     require C4::Items;
2962     while ( my ($itemnumber) = $sth->fetchrow_array ) {
2963         next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2964         my $i = $opachiddenitems ? C4::Items::GetItem($itemnumber) : undef;
2965         push @items, { itemnumber => $itemnumber, item => $i };
2966     }
2967     my @hiddenitems =
2968       $opachiddenitems
2969       ? C4::Items::GetHiddenItemnumbers( map { $_->{item} } @items )
2970       : ();
2971     # Convert to a hash for quick searching
2972     my %hiddenitems = map { $_ => 1 } @hiddenitems;
2973     foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2974         next if $hiddenitems{$itemnumber};
2975         my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2976         push @item_fields, $item_marc->field($itemtag);
2977     }
2978     $marc->append_fields(@item_fields);
2979 }
2980
2981 =head1 INTERNAL FUNCTIONS
2982
2983 =head2 _koha_marc_update_bib_ids
2984
2985
2986   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2987
2988 Internal function to add or update biblionumber and biblioitemnumber to
2989 the MARC XML.
2990
2991 =cut
2992
2993 sub _koha_marc_update_bib_ids {
2994     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2995
2996     # we must add bibnum and bibitemnum in MARC::Record...
2997     # we build the new field with biblionumber and biblioitemnumber
2998     # we drop the original field
2999     # we add the new builded field.
3000     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
3001     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
3002     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3003     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
3004
3005     if ( $biblio_tag == $biblioitem_tag ) {
3006
3007         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3008         my $new_field = MARC::Field->new(
3009             $biblio_tag, '', '',
3010             "$biblio_subfield"     => $biblionumber,
3011             "$biblioitem_subfield" => $biblioitemnumber
3012         );
3013
3014         # drop old field and create new one...
3015         my $old_field = $record->field($biblio_tag);
3016         $record->delete_field($old_field) if $old_field;
3017         $record->insert_fields_ordered($new_field);
3018     } else {
3019
3020         # biblionumber & biblioitemnumber are in different fields
3021
3022         # deal with biblionumber
3023         my ( $new_field, $old_field );
3024         if ( $biblio_tag < 10 ) {
3025             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3026         } else {
3027             $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3028         }
3029
3030         # drop old field and create new one...
3031         $old_field = $record->field($biblio_tag);
3032         $record->delete_field($old_field) if $old_field;
3033         $record->insert_fields_ordered($new_field);
3034
3035         # deal with biblioitemnumber
3036         if ( $biblioitem_tag < 10 ) {
3037             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3038         } else {
3039             $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3040         }
3041
3042         # drop old field and create new one...
3043         $old_field = $record->field($biblioitem_tag);
3044         $record->delete_field($old_field) if $old_field;
3045         $record->insert_fields_ordered($new_field);
3046     }
3047 }
3048
3049 =head2 _koha_marc_update_biblioitem_cn_sort
3050
3051   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3052
3053 Given a MARC bib record and the biblioitem hash, update the
3054 subfield that contains a copy of the value of biblioitems.cn_sort.
3055
3056 =cut
3057
3058 sub _koha_marc_update_biblioitem_cn_sort {
3059     my $marc          = shift;
3060     my $biblioitem    = shift;
3061     my $frameworkcode = shift;
3062
3063     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3064     return unless $biblioitem_tag;
3065
3066     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3067
3068     if ( my $field = $marc->field($biblioitem_tag) ) {
3069         $field->delete_subfield( code => $biblioitem_subfield );
3070         if ( $cn_sort ne '' ) {
3071             $field->add_subfields( $biblioitem_subfield => $cn_sort );
3072         }
3073     } else {
3074
3075         # if we get here, no biblioitem tag is present in the MARC record, so
3076         # we'll create it if $cn_sort is not empty -- this would be
3077         # an odd combination of events, however
3078         if ($cn_sort) {
3079             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3080         }
3081     }
3082 }
3083
3084 =head2 _koha_add_biblio
3085
3086   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3087
3088 Internal function to add a biblio ($biblio is a hash with the values)
3089
3090 =cut
3091
3092 sub _koha_add_biblio {
3093     my ( $dbh, $biblio, $frameworkcode ) = @_;
3094
3095     my $error;
3096
3097     # set the series flag
3098     unless (defined $biblio->{'serial'}){
3099         $biblio->{'serial'} = 0;
3100         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3101     }
3102
3103     my $query = "INSERT INTO biblio
3104         SET frameworkcode = ?,
3105             author = ?,
3106             title = ?,
3107             unititle =?,
3108             notes = ?,
3109             serial = ?,
3110             seriestitle = ?,
3111             copyrightdate = ?,
3112             datecreated=NOW(),
3113             abstract = ?
3114         ";
3115     my $sth = $dbh->prepare($query);
3116     $sth->execute(
3117         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3118         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3119     );
3120
3121     my $biblionumber = $dbh->{'mysql_insertid'};
3122     if ( $dbh->errstr ) {
3123         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3124         warn $error;
3125     }
3126
3127     $sth->finish();
3128
3129     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3130     return ( $biblionumber, $error );
3131 }
3132
3133 =head2 _koha_modify_biblio
3134
3135   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3136
3137 Internal function for updating the biblio table
3138
3139 =cut
3140
3141 sub _koha_modify_biblio {
3142     my ( $dbh, $biblio, $frameworkcode ) = @_;
3143     my $error;
3144
3145     my $query = "
3146         UPDATE biblio
3147         SET    frameworkcode = ?,
3148                author = ?,
3149                title = ?,
3150                unititle = ?,
3151                notes = ?,
3152                serial = ?,
3153                seriestitle = ?,
3154                copyrightdate = ?,
3155                abstract = ?
3156         WHERE  biblionumber = ?
3157         "
3158       ;
3159     my $sth = $dbh->prepare($query);
3160
3161     $sth->execute(
3162         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3163         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3164     ) if $biblio->{'biblionumber'};
3165
3166     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3167         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3168         warn $error;
3169     }
3170     return ( $biblio->{'biblionumber'}, $error );
3171 }
3172
3173 =head2 _koha_modify_biblioitem_nonmarc
3174
3175   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3176
3177 Updates biblioitems row except for marc and marcxml, which should be changed
3178 via ModBiblioMarc
3179
3180 =cut
3181
3182 sub _koha_modify_biblioitem_nonmarc {
3183     my ( $dbh, $biblioitem ) = @_;
3184     my $error;
3185
3186     # re-calculate the cn_sort, it may have changed
3187     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3188
3189     my $query = "UPDATE biblioitems
3190     SET biblionumber    = ?,
3191         volume          = ?,
3192         number          = ?,
3193         itemtype        = ?,
3194         isbn            = ?,
3195         issn            = ?,
3196         publicationyear = ?,
3197         publishercode   = ?,
3198         volumedate      = ?,
3199         volumedesc      = ?,
3200         collectiontitle = ?,
3201         collectionissn  = ?,
3202         collectionvolume= ?,
3203         editionstatement= ?,
3204         editionresponsibility = ?,
3205         illus           = ?,
3206         pages           = ?,
3207         notes           = ?,
3208         size            = ?,
3209         place           = ?,
3210         lccn            = ?,
3211         url             = ?,
3212         cn_source       = ?,
3213         cn_class        = ?,
3214         cn_item         = ?,
3215         cn_suffix       = ?,
3216         cn_sort         = ?,
3217         totalissues     = ?,
3218         ean             = ?,
3219         agerestriction  = ?
3220         where biblioitemnumber = ?
3221         ";
3222     my $sth = $dbh->prepare($query);
3223     $sth->execute(
3224         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3225         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3226         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3227         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3228         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3229         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3230         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3231         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
3232     );
3233     if ( $dbh->errstr ) {
3234         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3235         warn $error;
3236     }
3237     return ( $biblioitem->{'biblioitemnumber'}, $error );
3238 }
3239
3240 =head2 _koha_add_biblioitem
3241
3242   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3243
3244 Internal function to add a biblioitem
3245
3246 =cut
3247
3248 sub _koha_add_biblioitem {
3249     my ( $dbh, $biblioitem ) = @_;
3250     my $error;
3251
3252     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3253     my $query = "INSERT INTO biblioitems SET
3254         biblionumber    = ?,
3255         volume          = ?,
3256         number          = ?,
3257         itemtype        = ?,
3258         isbn            = ?,
3259         issn            = ?,
3260         publicationyear = ?,
3261         publishercode   = ?,
3262         volumedate      = ?,
3263         volumedesc      = ?,
3264         collectiontitle = ?,
3265         collectionissn  = ?,
3266         collectionvolume= ?,
3267         editionstatement= ?,
3268         editionresponsibility = ?,
3269         illus           = ?,
3270         pages           = ?,
3271         notes           = ?,
3272         size            = ?,
3273         place           = ?,
3274         lccn            = ?,
3275         marc            = ?,
3276         url             = ?,
3277         cn_source       = ?,
3278         cn_class        = ?,
3279         cn_item         = ?,
3280         cn_suffix       = ?,
3281         cn_sort         = ?,
3282         totalissues     = ?,
3283         ean             = ?,
3284         agerestriction  = ?
3285         ";
3286     my $sth = $dbh->prepare($query);
3287     $sth->execute(
3288         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3289         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3290         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3291         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3292         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3293         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3294         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3295         $biblioitem->{'totalissues'},      $biblioitem->{'ean'},              $biblioitem->{'agerestriction'}
3296     );
3297     my $bibitemnum = $dbh->{'mysql_insertid'};
3298
3299     if ( $dbh->errstr ) {
3300         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3301         warn $error;
3302     }
3303     $sth->finish();
3304     return ( $bibitemnum, $error );
3305 }
3306
3307 =head2 _koha_delete_biblio
3308
3309   $error = _koha_delete_biblio($dbh,$biblionumber);
3310
3311 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3312
3313 C<$dbh> - the database handle
3314
3315 C<$biblionumber> - the biblionumber of the biblio to be deleted
3316
3317 =cut
3318
3319 # FIXME: add error handling
3320
3321 sub _koha_delete_biblio {
3322     my ( $dbh, $biblionumber ) = @_;
3323
3324     # get all the data for this biblio
3325     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3326     $sth->execute($biblionumber);
3327
3328     if ( my $data = $sth->fetchrow_hashref ) {
3329
3330         # save the record in deletedbiblio
3331         # find the fields to save
3332         my $query = "INSERT INTO deletedbiblio SET ";
3333         my @bind  = ();
3334         foreach my $temp ( keys %$data ) {
3335             $query .= "$temp = ?,";
3336             push( @bind, $data->{$temp} );
3337         }
3338
3339         # replace the last , by ",?)"
3340         $query =~ s/\,$//;
3341         my $bkup_sth = $dbh->prepare($query);
3342         $bkup_sth->execute(@bind);
3343         $bkup_sth->finish;
3344
3345         # delete the biblio
3346         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3347         $sth2->execute($biblionumber);
3348         # update the timestamp (Bugzilla 7146)
3349         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3350         $sth2->execute($biblionumber);
3351         $sth2->finish;
3352     }
3353     $sth->finish;
3354     return;
3355 }
3356
3357 =head2 _koha_delete_biblioitems
3358
3359   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3360
3361 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3362
3363 C<$dbh> - the database handle
3364 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3365
3366 =cut
3367
3368 # FIXME: add error handling
3369
3370 sub _koha_delete_biblioitems {
3371     my ( $dbh, $biblioitemnumber ) = @_;
3372
3373     # get all the data for this biblioitem
3374     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3375     $sth->execute($biblioitemnumber);
3376
3377     if ( my $data = $sth->fetchrow_hashref ) {
3378
3379         # save the record in deletedbiblioitems
3380         # find the fields to save
3381         my $query = "INSERT INTO deletedbiblioitems SET ";
3382         my @bind  = ();
3383         foreach my $temp ( keys %$data ) {
3384             $query .= "$temp = ?,";
3385             push( @bind, $data->{$temp} );
3386         }
3387
3388         # replace the last , by ",?)"
3389         $query =~ s/\,$//;
3390         my $bkup_sth = $dbh->prepare($query);
3391         $bkup_sth->execute(@bind);
3392         $bkup_sth->finish;
3393
3394         # delete the biblioitem
3395         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3396         $sth2->execute($biblioitemnumber);
3397         # update the timestamp (Bugzilla 7146)
3398         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3399         $sth2->execute($biblioitemnumber);
3400         $sth2->finish;
3401     }
3402     $sth->finish;
3403     return;
3404 }
3405
3406 =head1 UNEXPORTED FUNCTIONS
3407
3408 =head2 ModBiblioMarc
3409
3410   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3411
3412 Add MARC data for a biblio to koha
3413
3414 Function exported, but should NOT be used, unless you really know what you're doing
3415
3416 =cut
3417
3418 sub ModBiblioMarc {
3419     # pass the MARC::Record to this function, and it will create the records in
3420     # the marc field
3421     my ( $record, $biblionumber, $frameworkcode ) = @_;
3422     if ( !$record ) {
3423         carp 'ModBiblioMarc passed an undefined record';
3424         return;
3425     }
3426
3427     # Clone record as it gets modified
3428     $record = $record->clone();
3429     my $dbh    = C4::Context->dbh;
3430     my @fields = $record->fields();
3431     if ( !$frameworkcode ) {
3432         $frameworkcode = "";
3433     }
3434     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3435     $sth->execute( $frameworkcode, $biblionumber );
3436     $sth->finish;
3437     my $encoding = C4::Context->preference("marcflavour");
3438
3439     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3440     if ( $encoding eq "UNIMARC" ) {
3441         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3442         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3443         my $string = $record->subfield( 100, "a" );
3444         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3445             my $f100 = $record->field(100);
3446             $record->delete_field($f100);
3447         } else {
3448             $string = POSIX::strftime( "%Y%m%d", localtime );
3449             $string =~ s/\-//g;
3450             $string = sprintf( "%-*s", 35, $string );
3451             substr ( $string, 22, 3, $defaultlanguage);
3452         }
3453         substr( $string, 25, 3, "y50" );
3454         unless ( $record->subfield( 100, "a" ) ) {
3455             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3456         }
3457     }
3458
3459     #enhancement 5374: update transaction date (005) for marc21/unimarc
3460     if($encoding =~ /MARC21|UNIMARC/) {
3461       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3462         # YY MM DD HH MM SS (update year and month)
3463       my $f005= $record->field('005');
3464       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3465     }
3466
3467     $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3468     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3469     $sth->finish;
3470     ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
3471     return $biblionumber;
3472 }
3473
3474 =head2 get_biblio_authorised_values
3475
3476 find the types and values for all authorised values assigned to this biblio.
3477
3478 parameters:
3479     biblionumber
3480     MARC::Record of the bib
3481
3482 returns: a hashref mapping the authorised value to the value set for this biblionumber
3483
3484   $authorised_values = {
3485                        'Scent'     => 'flowery',
3486                        'Audience'  => 'Young Adult',
3487                        'itemtypes' => 'SER',
3488                         };
3489
3490 Notes: forlibrarian should probably be passed in, and called something different.
3491
3492 =cut
3493
3494 sub get_biblio_authorised_values {
3495     my $biblionumber = shift;
3496     my $record       = shift;
3497
3498     my $forlibrarian  = 1;                                 # are we in staff or opac?
3499     my $frameworkcode = GetFrameworkCode($biblionumber);
3500
3501     my $authorised_values;
3502
3503     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3504       or return $authorised_values;
3505
3506     # assume that these entries in the authorised_value table are bibliolevel.
3507     # ones that start with 'item%' are item level.
3508     my $query = q(SELECT distinct authorised_value, kohafield
3509                     FROM marc_subfield_structure
3510                     WHERE authorised_value !=''
3511                       AND (kohafield like 'biblio%'
3512                        OR  kohafield like '') );
3513     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3514
3515     foreach my $tag ( keys(%$tagslib) ) {
3516         foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3517
3518             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3519             if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3520                 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3521                     if ( defined $record->field($tag) ) {
3522                         my $this_subfield_value = $record->field($tag)->subfield($subfield);
3523                         if ( defined $this_subfield_value ) {
3524                             $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3525                         }
3526                     }
3527                 }
3528             }
3529         }
3530     }
3531
3532     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3533     return $authorised_values;
3534 }
3535
3536 =head2 CountBiblioInOrders
3537
3538     $count = &CountBiblioInOrders( $biblionumber);
3539
3540 This function return count of biblios in orders with $biblionumber
3541
3542 =cut
3543
3544 sub CountBiblioInOrders {
3545  my ($biblionumber) = @_;
3546     my $dbh            = C4::Context->dbh;
3547     my $query          = "SELECT count(*)
3548           FROM  aqorders
3549           WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3550     my $sth = $dbh->prepare($query);
3551     $sth->execute($biblionumber);
3552     my $count = $sth->fetchrow;
3553     return ($count);
3554 }
3555
3556 =head2 GetSubscriptionsId
3557
3558     $subscriptions = &GetSubscriptionsId($biblionumber);
3559
3560 This function return an array of subscriptionid with $biblionumber
3561
3562 =cut
3563
3564 sub GetSubscriptionsId {
3565  my ($biblionumber) = @_;
3566     my $dbh            = C4::Context->dbh;
3567     my $query          = "SELECT subscriptionid
3568           FROM  subscription
3569           WHERE biblionumber=?";
3570     my $sth = $dbh->prepare($query);
3571     $sth->execute($biblionumber);
3572     my @subscriptions = $sth->fetchrow_array;
3573     return (@subscriptions);
3574 }
3575
3576 =head2 GetHolds
3577
3578     $holds = &GetHolds($biblionumber);
3579
3580 This function return the count of holds with $biblionumber
3581
3582 =cut
3583
3584 sub GetHolds {
3585  my ($biblionumber) = @_;
3586     my $dbh            = C4::Context->dbh;
3587     my $query          = "SELECT count(*)
3588           FROM  reserves
3589           WHERE biblionumber=?";
3590     my $sth = $dbh->prepare($query);
3591     $sth->execute($biblionumber);
3592     my $holds = $sth->fetchrow;
3593     return ($holds);
3594 }
3595
3596 =head2 prepare_host_field
3597
3598 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3599 Generate the host item entry for an analytic child entry
3600
3601 =cut
3602
3603 sub prepare_host_field {
3604     my ( $hostbiblio, $marcflavour ) = @_;
3605     $marcflavour ||= C4::Context->preference('marcflavour');
3606     my $host = GetMarcBiblio($hostbiblio);
3607     # unfortunately as_string does not 'do the right thing'
3608     # if field returns undef
3609     my %sfd;
3610     my $field;
3611     my $host_field;
3612     if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3613         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3614             my $s = $field->as_string('ab');
3615             if ($s) {
3616                 $sfd{a} = $s;
3617             }
3618         }
3619         if ( $field = $host->field('245') ) {
3620             my $s = $field->as_string('a');
3621             if ($s) {
3622                 $sfd{t} = $s;
3623             }
3624         }
3625         if ( $field = $host->field('260') ) {
3626             my $s = $field->as_string('abc');
3627             if ($s) {
3628                 $sfd{d} = $s;
3629             }
3630         }
3631         if ( $field = $host->field('240') ) {
3632             my $s = $field->as_string();
3633             if ($s) {
3634                 $sfd{b} = $s;
3635             }
3636         }
3637         if ( $field = $host->field('022') ) {
3638             my $s = $field->as_string('a');
3639             if ($s) {
3640                 $sfd{x} = $s;
3641             }
3642         }
3643         if ( $field = $host->field('020') ) {
3644             my $s = $field->as_string('a');
3645             if ($s) {
3646                 $sfd{z} = $s;
3647             }
3648         }
3649         if ( $field = $host->field('001') ) {
3650             $sfd{w} = $field->data(),;
3651         }
3652         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3653         return $host_field;
3654     }
3655     elsif ( $marcflavour eq 'UNIMARC' ) {
3656         #author
3657         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3658             my $s = $field->as_string('ab');
3659             if ($s) {
3660                 $sfd{a} = $s;
3661             }
3662         }
3663         #title
3664         if ( $field = $host->field('200') ) {
3665             my $s = $field->as_string('a');
3666             if ($s) {
3667                 $sfd{t} = $s;
3668             }
3669         }
3670         #place of publicaton
3671         if ( $field = $host->field('210') ) {
3672             my $s = $field->as_string('a');
3673             if ($s) {
3674                 $sfd{c} = $s;
3675             }
3676         }
3677         #date of publication
3678         if ( $field = $host->field('210') ) {
3679             my $s = $field->as_string('d');
3680             if ($s) {
3681                 $sfd{d} = $s;
3682             }
3683         }
3684         #edition statement
3685         if ( $field = $host->field('205') ) {
3686             my $s = $field->as_string();
3687             if ($s) {
3688                 $sfd{e} = $s;
3689             }
3690         }
3691         #URL
3692         if ( $field = $host->field('856') ) {
3693             my $s = $field->as_string('u');
3694             if ($s) {
3695                 $sfd{u} = $s;
3696             }
3697         }
3698         #ISSN
3699         if ( $field = $host->field('011') ) {
3700             my $s = $field->as_string('a');
3701             if ($s) {
3702                 $sfd{x} = $s;
3703             }
3704         }
3705         #ISBN
3706         if ( $field = $host->field('010') ) {
3707             my $s = $field->as_string('a');
3708             if ($s) {
3709                 $sfd{y} = $s;
3710             }
3711         }
3712         if ( $field = $host->field('001') ) {
3713             $sfd{0} = $field->data(),;
3714         }
3715         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3716         return $host_field;
3717     }
3718     return;
3719 }
3720
3721
3722 =head2 UpdateTotalIssues
3723
3724   UpdateTotalIssues($biblionumber, $increase, [$value])
3725
3726 Update the total issue count for a particular bib record.
3727
3728 =over 4
3729
3730 =item C<$biblionumber> is the biblionumber of the bib to update
3731
3732 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3733
3734 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3735
3736 =back
3737
3738 =cut
3739
3740 sub UpdateTotalIssues {
3741     my ($biblionumber, $increase, $value) = @_;
3742     my $totalissues;
3743
3744     my $record = GetMarcBiblio($biblionumber);
3745     unless ($record) {
3746         carp "UpdateTotalIssues could not get biblio record";
3747         return;
3748     }
3749     my $data = GetBiblioData($biblionumber);
3750     unless ($data) {
3751         carp "UpdateTotalIssues could not get datas of biblio";
3752         return;
3753     }
3754     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
3755     unless ($totalissuestag) {
3756         return 1; # There is nothing to do
3757     }
3758
3759     if (defined $value) {
3760         $totalissues = $value;
3761     } else {
3762         $totalissues = $data->{'totalissues'} + $increase;
3763     }
3764
3765      my $field = $record->field($totalissuestag);
3766      if (defined $field) {
3767          $field->update( $totalissuessubfield => $totalissues );
3768      } else {
3769          $field = MARC::Field->new($totalissuestag, '0', '0',
3770                  $totalissuessubfield => $totalissues);
3771          $record->insert_grouped_field($field);
3772      }
3773
3774      return ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
3775 }
3776
3777 =head2 RemoveAllNsb
3778
3779     &RemoveAllNsb($record);
3780
3781 Removes all nsb/nse chars from a record
3782
3783 =cut
3784
3785 sub RemoveAllNsb {
3786     my $record = shift;
3787     if (!$record) {
3788         carp 'RemoveAllNsb called with undefined record';
3789         return;
3790     }
3791
3792     SetUTF8Flag($record);
3793
3794     foreach my $field ($record->fields()) {
3795         if ($field->is_control_field()) {
3796             $field->update(nsb_clean($field->data()));
3797         } else {
3798             my @subfields = $field->subfields();
3799             my @new_subfields;
3800             foreach my $subfield (@subfields) {
3801                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3802             }
3803             if (scalar(@new_subfields) > 0) {
3804                 my $new_field;
3805                 eval {
3806                     $new_field = MARC::Field->new(
3807                         $field->tag(),
3808                         $field->indicator(1),
3809                         $field->indicator(2),
3810                         @new_subfields
3811                     );
3812                 };
3813                 if ($@) {
3814                     warn "error in RemoveAllNsb : $@";
3815                 } else {
3816                     $field->replace_with($new_field);
3817                 }
3818             }
3819         }
3820     }
3821
3822     return $record;
3823 }
3824
3825 1;
3826
3827
3828 __END__
3829
3830 =head1 AUTHOR
3831
3832 Koha Development Team <http://koha-community.org/>
3833
3834 Paul POULAIN paul.poulain@free.fr
3835
3836 Joshua Ferraro jmf@liblime.com
3837
3838 =cut