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