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