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     $frameworkcode = "" unless $frameworkcode;
1118
1119     $forlibrarian = $forlibrarian ? 1 : 0;
1120     my $cache = Koha::Cache->get_instance();
1121     my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
1122     my $cached = $cache->get_from_cache($cache_key);
1123     return $cached if $cached;
1124
1125     my $dbh = C4::Context->dbh;
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
1671     if ( !$category ) {
1672
1673         return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1674
1675         #---- branch
1676         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1677             return C4::Branch::GetBranchName($value);
1678         }
1679
1680         #---- itemtypes
1681         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1682             return getitemtypeinfo($value)->{translated_description};
1683         }
1684
1685         #---- "true" authorized value
1686         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1687     }
1688
1689     my $dbh = C4::Context->dbh;
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     ## FIXME: $dbh parameter is never used inside this subroutine ???
2622
2623     my $result = {};
2624     if (!defined $record) {
2625         carp('TransformMarcToKoha called with undefined record');
2626         return $result;
2627     }
2628     $limit_table = $limit_table || 0;
2629     $frameworkcode = '' unless defined $frameworkcode;
2630
2631     unless ( defined $inverted_field_map ) {
2632         $inverted_field_map = _get_inverted_marc_field_map();
2633     }
2634
2635     my %tables = ();
2636     if ( defined $limit_table && $limit_table eq 'items' ) {
2637         $tables{'items'} = 1;
2638     } else {
2639         $tables{'items'}       = 1;
2640         $tables{'biblio'}      = 1;
2641         $tables{'biblioitems'} = 1;
2642     }
2643
2644     # traverse through record
2645   MARCFIELD: foreach my $field ( $record->fields() ) {
2646         my $tag = $field->tag();
2647         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2648         if ( $field->is_control_field() ) {
2649             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2650           ENTRY: foreach my $entry ( @{$kohafields} ) {
2651                 my ( $subfield, $table, $column ) = @{$entry};
2652                 next ENTRY unless exists $tables{$table};
2653                 my $key = _disambiguate( $table, $column );
2654                 if ( $result->{$key} ) {
2655                     unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2656                         $result->{$key} .= " | " . $field->data();
2657                     }
2658                 } else {
2659                     $result->{$key} = $field->data();
2660                 }
2661             }
2662         } else {
2663
2664             # deal with subfields
2665           MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2666                 my $code = $sf->[0];
2667                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2668                 my $value = $sf->[1];
2669               SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2670                     my ( $table, $column ) = @{$entry};
2671                     next SFENTRY unless exists $tables{$table};
2672                     my $key = _disambiguate( $table, $column );
2673                     if ( $result->{$key} ) {
2674                         unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2675                             $result->{$key} .= " | " . $value;
2676                         }
2677                     } else {
2678                         $result->{$key} = $value;
2679                     }
2680                 }
2681             }
2682         }
2683     }
2684
2685     # modify copyrightdate to keep only the 1st year found
2686     if ( exists $result->{'copyrightdate'} ) {
2687         my $temp = $result->{'copyrightdate'};
2688         $temp =~ m/c(\d\d\d\d)/;
2689         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2690             $result->{'copyrightdate'} = $1;
2691         } else {                                       # if no cYYYY, get the 1st date.
2692             $temp =~ m/(\d\d\d\d)/;
2693             $result->{'copyrightdate'} = $1;
2694         }
2695     }
2696
2697     # modify publicationyear to keep only the 1st year found
2698     if ( exists $result->{'publicationyear'} ) {
2699         my $temp = $result->{'publicationyear'};
2700         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2701             $result->{'publicationyear'} = $1;
2702         } else {                                       # if no cYYYY, get the 1st date.
2703             $temp =~ m/(\d\d\d\d)/;
2704             $result->{'publicationyear'} = $1;
2705         }
2706     }
2707
2708     return $result;
2709 }
2710
2711 sub _get_inverted_marc_field_map {
2712     my $field_map = {};
2713     my $relations = C4::Context->marcfromkohafield;
2714
2715     foreach my $frameworkcode ( keys %{$relations} ) {
2716         foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2717             next unless @{ $relations->{$frameworkcode}->{$kohafield} };    # not all columns are mapped to MARC tag & subfield
2718             my $tag      = $relations->{$frameworkcode}->{$kohafield}->[0];
2719             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2720             my ( $table, $column ) = split /[.]/, $kohafield, 2;
2721             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2722             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2723         }
2724     }
2725     return $field_map;
2726 }
2727
2728 =head2 _disambiguate
2729
2730   $newkey = _disambiguate($table, $field);
2731
2732 This is a temporary hack to distinguish between the
2733 following sets of columns when using TransformMarcToKoha.
2734
2735   items.cn_source & biblioitems.cn_source
2736   items.cn_sort & biblioitems.cn_sort
2737
2738 Columns that are currently NOT distinguished (FIXME
2739 due to lack of time to fully test) are:
2740
2741   biblio.notes and biblioitems.notes
2742   biblionumber
2743   timestamp
2744   biblioitemnumber
2745
2746 FIXME - this is necessary because prefixing each column
2747 name with the table name would require changing lots
2748 of code and templates, and exposing more of the DB
2749 structure than is good to the UI templates, particularly
2750 since biblio and bibloitems may well merge in a future
2751 version.  In the future, it would also be good to
2752 separate DB access and UI presentation field names
2753 more.
2754
2755 =cut
2756
2757 sub CountItemsIssued {
2758     my ($biblionumber) = @_;
2759     my $dbh            = C4::Context->dbh;
2760     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2761     $sth->execute($biblionumber);
2762     my $row = $sth->fetchrow_hashref();
2763     return $row->{'issuedCount'};
2764 }
2765
2766 sub _disambiguate {
2767     my ( $table, $column ) = @_;
2768     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2769         return $table . '.' . $column;
2770     } else {
2771         return $column;
2772     }
2773
2774 }
2775
2776 =head2 get_koha_field_from_marc
2777
2778   $result->{_disambiguate($table, $field)} =
2779      get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2780
2781 Internal function to map data from the MARC record to a specific non-MARC field.
2782 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2783
2784 =cut
2785
2786 sub get_koha_field_from_marc {
2787     my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2788     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2789     my $kohafield;
2790     foreach my $field ( $record->field($tagfield) ) {
2791         if ( $field->tag() < 10 ) {
2792             if ($kohafield) {
2793                 $kohafield .= " | " . $field->data();
2794             } else {
2795                 $kohafield = $field->data();
2796             }
2797         } else {
2798             if ( $field->subfields ) {
2799                 my @subfields = $field->subfields();
2800                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2801                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2802                         if ($kohafield) {
2803                             $kohafield .= " | " . $subfields[$subfieldcount][1];
2804                         } else {
2805                             $kohafield = $subfields[$subfieldcount][1];
2806                         }
2807                     }
2808                 }
2809             }
2810         }
2811     }
2812     return $kohafield;
2813 }
2814
2815 =head2 TransformMarcToKohaOneField
2816
2817   $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2818
2819 =cut
2820
2821 sub TransformMarcToKohaOneField {
2822
2823     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2824     # only the 1st will be retrieved...
2825     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2826     my $res = "";
2827     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2828     foreach my $field ( $record->field($tagfield) ) {
2829         if ( $field->tag() < 10 ) {
2830             if ( $result->{$kohafield} ) {
2831                 $result->{$kohafield} .= " | " . $field->data();
2832             } else {
2833                 $result->{$kohafield} = $field->data();
2834             }
2835         } else {
2836             if ( $field->subfields ) {
2837                 my @subfields = $field->subfields();
2838                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2839                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2840                         if ( $result->{$kohafield} ) {
2841                             $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2842                         } else {
2843                             $result->{$kohafield} = $subfields[$subfieldcount][1];
2844                         }
2845                     }
2846                 }
2847             }
2848         }
2849     }
2850     return $result;
2851 }
2852
2853
2854 #"
2855
2856 #
2857 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2858 # at the same time
2859 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2860 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2861 # =head2 ModZebrafiles
2862 #
2863 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2864 #
2865 # =cut
2866 #
2867 # sub ModZebrafiles {
2868 #
2869 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2870 #
2871 #     my $op;
2872 #     my $zebradir =
2873 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2874 #     unless ( opendir( DIR, "$zebradir" ) ) {
2875 #         warn "$zebradir not found";
2876 #         return;
2877 #     }
2878 #     closedir DIR;
2879 #     my $filename = $zebradir . $biblionumber;
2880 #
2881 #     if ($record) {
2882 #         open( OUTPUT, ">", $filename . ".xml" );
2883 #         print OUTPUT $record;
2884 #         close OUTPUT;
2885 #     }
2886 # }
2887
2888 =head2 ModZebra
2889
2890   ModZebra( $biblionumber, $op, $server );
2891
2892 $biblionumber is the biblionumber we want to index
2893
2894 $op is specialUpdate or delete, and is used to know what we want to do
2895
2896 $server is the server that we want to update
2897
2898 =cut
2899
2900 sub ModZebra {
2901 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2902     my ( $biblionumber, $op, $server ) = @_;
2903     my $dbh = C4::Context->dbh;
2904
2905     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2906     # at the same time
2907     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2908     # the table is emptied by rebuild_zebra.pl script (using the -z switch)
2909
2910     my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2911                      WHERE server = ?
2912                      AND   biblio_auth_number = ?
2913                      AND   operation = ?
2914                      AND   done = 0";
2915     my $check_sth = $dbh->prepare_cached($check_sql);
2916     $check_sth->execute( $server, $biblionumber, $op );
2917     my ($count) = $check_sth->fetchrow_array;
2918     $check_sth->finish();
2919     if ( $count == 0 ) {
2920         my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2921         $sth->execute( $biblionumber, $server, $op );
2922         $sth->finish;
2923     }
2924 }
2925
2926
2927 =head2 EmbedItemsInMarcBiblio
2928
2929     EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers, $opac);
2930
2931 Given a MARC::Record object containing a bib record,
2932 modify it to include the items attached to it as 9XX
2933 per the bib's MARC framework.
2934 if $itemnumbers is defined, only specified itemnumbers are embedded.
2935
2936 If $opac is true, then opac-relevant suppressions are included.
2937
2938 =cut
2939
2940 sub EmbedItemsInMarcBiblio {
2941     my ($marc, $biblionumber, $itemnumbers, $opac) = @_;
2942     if ( !$marc ) {
2943         carp 'EmbedItemsInMarcBiblio: No MARC record passed';
2944         return;
2945     }
2946
2947     $itemnumbers = [] unless defined $itemnumbers;
2948
2949     my $frameworkcode = GetFrameworkCode($biblionumber);
2950     _strip_item_fields($marc, $frameworkcode);
2951
2952     # ... and embed the current items
2953     my $dbh = C4::Context->dbh;
2954     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2955     $sth->execute($biblionumber);
2956     my @item_fields;
2957     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2958     my @items;
2959     my $opachiddenitems = $opac
2960       && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ );
2961     require C4::Items;
2962     while ( my ($itemnumber) = $sth->fetchrow_array ) {
2963         next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2964         my $i = $opachiddenitems ? C4::Items::GetItem($itemnumber) : undef;
2965         push @items, { itemnumber => $itemnumber, item => $i };
2966     }
2967     my @hiddenitems =
2968       $opachiddenitems
2969       ? C4::Items::GetHiddenItemnumbers( map { $_->{item} } @items )
2970       : ();
2971     # Convert to a hash for quick searching
2972     my %hiddenitems = map { $_ => 1 } @hiddenitems;
2973     foreach my $itemnumber ( map { $_->{itemnumber} } @items ) {
2974         next if $hiddenitems{$itemnumber};
2975         my $item_marc = C4::Items::GetMarcItem( $biblionumber, $itemnumber );
2976         push @item_fields, $item_marc->field($itemtag);
2977     }
2978     $marc->append_fields(@item_fields);
2979 }
2980
2981 =head1 INTERNAL FUNCTIONS
2982
2983 =head2 _koha_marc_update_bib_ids
2984
2985
2986   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2987
2988 Internal function to add or update biblionumber and biblioitemnumber to
2989 the MARC XML.
2990
2991 =cut
2992
2993 sub _koha_marc_update_bib_ids {
2994     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
2995
2996     # we must add bibnum and bibitemnum in MARC::Record...
2997     # we build the new field with biblionumber and biblioitemnumber
2998     # we drop the original field
2999     # we add the new builded field.
3000     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
3001     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
3002     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3003     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
3004
3005     if ( $biblio_tag == $biblioitem_tag ) {
3006
3007         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3008         my $new_field = MARC::Field->new(
3009             $biblio_tag, '', '',
3010             "$biblio_subfield"     => $biblionumber,
3011             "$biblioitem_subfield" => $biblioitemnumber
3012         );
3013
3014         # drop old field and create new one...
3015         my $old_field = $record->field($biblio_tag);
3016         $record->delete_field($old_field) if $old_field;
3017         $record->insert_fields_ordered($new_field);
3018     } else {
3019
3020         # biblionumber & biblioitemnumber are in different fields
3021
3022         # deal with biblionumber
3023         my ( $new_field, $old_field );
3024         if ( $biblio_tag < 10 ) {
3025             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3026         } else {
3027             $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3028         }
3029
3030         # drop old field and create new one...
3031         $old_field = $record->field($biblio_tag);
3032         $record->delete_field($old_field) if $old_field;
3033         $record->insert_fields_ordered($new_field);
3034
3035         # deal with biblioitemnumber
3036         if ( $biblioitem_tag < 10 ) {
3037             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3038         } else {
3039             $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3040         }
3041
3042         # drop old field and create new one...
3043         $old_field = $record->field($biblioitem_tag);
3044         $record->delete_field($old_field) if $old_field;
3045         $record->insert_fields_ordered($new_field);
3046     }
3047 }
3048
3049 =head2 _koha_marc_update_biblioitem_cn_sort
3050
3051   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3052
3053 Given a MARC bib record and the biblioitem hash, update the
3054 subfield that contains a copy of the value of biblioitems.cn_sort.
3055
3056 =cut
3057
3058 sub _koha_marc_update_biblioitem_cn_sort {
3059     my $marc          = shift;
3060     my $biblioitem    = shift;
3061     my $frameworkcode = shift;
3062
3063     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3064     return unless $biblioitem_tag;
3065
3066     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3067
3068     if ( my $field = $marc->field($biblioitem_tag) ) {
3069         $field->delete_subfield( code => $biblioitem_subfield );
3070         if ( $cn_sort ne '' ) {
3071             $field->add_subfields( $biblioitem_subfield => $cn_sort );
3072         }
3073     } else {
3074
3075         # if we get here, no biblioitem tag is present in the MARC record, so
3076         # we'll create it if $cn_sort is not empty -- this would be
3077         # an odd combination of events, however
3078         if ($cn_sort) {
3079             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3080         }
3081     }
3082 }
3083
3084 =head2 _koha_add_biblio
3085
3086   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3087
3088 Internal function to add a biblio ($biblio is a hash with the values)
3089
3090 =cut
3091
3092 sub _koha_add_biblio {
3093     my ( $dbh, $biblio, $frameworkcode ) = @_;
3094
3095     my $error;
3096
3097     # set the series flag
3098     unless (defined $biblio->{'serial'}){
3099         $biblio->{'serial'} = 0;
3100         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3101     }
3102
3103     my $query = "INSERT INTO biblio
3104         SET frameworkcode = ?,
3105             author = ?,
3106             title = ?,
3107             unititle =?,
3108             notes = ?,
3109             serial = ?,
3110             seriestitle = ?,
3111             copyrightdate = ?,
3112             datecreated=NOW(),
3113             abstract = ?
3114         ";
3115     my $sth = $dbh->prepare($query);
3116     $sth->execute(
3117         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3118         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3119     );
3120
3121     my $biblionumber = $dbh->{'mysql_insertid'};
3122     if ( $dbh->errstr ) {
3123         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3124         warn $error;
3125     }
3126
3127     $sth->finish();
3128
3129     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3130     return ( $biblionumber, $error );
3131 }
3132
3133 =head2 _koha_modify_biblio
3134
3135   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3136
3137 Internal function for updating the biblio table
3138
3139 =cut
3140
3141 sub _koha_modify_biblio {
3142     my ( $dbh, $biblio, $frameworkcode ) = @_;
3143     my $error;
3144
3145     my $query = "
3146         UPDATE biblio
3147         SET    frameworkcode = ?,
3148                author = ?,
3149                title = ?,
3150                unititle = ?,
3151                notes = ?,
3152                serial = ?,
3153                seriestitle = ?,
3154                copyrightdate = ?,
3155                abstract = ?
3156         WHERE  biblionumber = ?
3157         "
3158       ;
3159     my $sth = $dbh->prepare($query);
3160
3161     $sth->execute(
3162         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3163         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3164     ) if $biblio->{'biblionumber'};
3165
3166     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3167         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3168         warn $error;
3169     }
3170     return ( $biblio->{'biblionumber'}, $error );
3171 }
3172
3173 =head2 _koha_modify_biblioitem_nonmarc
3174
3175   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3176
3177 Updates biblioitems row except for marc and marcxml, which should be changed
3178 via ModBiblioMarc
3179
3180 =cut
3181
3182 sub _koha_modify_biblioitem_nonmarc {
3183     my ( $dbh, $biblioitem ) = @_;
3184     my $error;
3185
3186     # re-calculate the cn_sort, it may have changed
3187     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3188
3189     my $query = "UPDATE biblioitems
3190     SET biblionumber    = ?,
3191         volume          = ?,
3192         number          = ?,
3193         itemtype        = ?,
3194         isbn            = ?,
3195         issn            = ?,
3196         publicationyear = ?,
3197         publishercode   = ?,
3198         volumedate      = ?,
3199         volumedesc      = ?,
3200         collectiontitle = ?,
3201         collectionissn  = ?,
3202         collectionvolume= ?,
3203         editionstatement= ?,
3204         editionresponsibility = ?,
3205         illus           = ?,
3206         pages           = ?,
3207         notes           = ?,
3208         size            = ?,
3209         place           = ?,
3210         lccn            = ?,
3211         url             = ?,
3212         cn_source       = ?,
3213         cn_class        = ?,
3214         cn_item         = ?,
3215         cn_suffix       = ?,
3216         cn_sort         = ?,
3217         totalissues     = ?,
3218         ean             = ?,
3219         agerestriction  = ?
3220         where biblioitemnumber = ?
3221         ";
3222     my $sth = $dbh->prepare($query);
3223     $sth->execute(
3224         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3225         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3226         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3227         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3228         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3229         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3230         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3231         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
3232     );
3233     if ( $dbh->errstr ) {
3234         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3235         warn $error;
3236     }
3237     return ( $biblioitem->{'biblioitemnumber'}, $error );
3238 }
3239
3240 =head2 _koha_add_biblioitem
3241
3242   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3243
3244 Internal function to add a biblioitem
3245
3246 =cut
3247
3248 sub _koha_add_biblioitem {
3249     my ( $dbh, $biblioitem ) = @_;
3250     my $error;
3251
3252     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3253     my $query = "INSERT INTO biblioitems SET
3254         biblionumber    = ?,
3255         volume          = ?,
3256         number          = ?,
3257         itemtype        = ?,
3258         isbn            = ?,
3259         issn            = ?,
3260         publicationyear = ?,
3261         publishercode   = ?,
3262         volumedate      = ?,
3263         volumedesc      = ?,
3264         collectiontitle = ?,
3265         collectionissn  = ?,
3266         collectionvolume= ?,
3267         editionstatement= ?,
3268         editionresponsibility = ?,
3269         illus           = ?,
3270         pages           = ?,
3271         notes           = ?,
3272         size            = ?,
3273         place           = ?,
3274         lccn            = ?,
3275         marc            = ?,
3276         url             = ?,
3277         cn_source       = ?,
3278         cn_class        = ?,
3279         cn_item         = ?,
3280         cn_suffix       = ?,
3281         cn_sort         = ?,
3282         totalissues     = ?,
3283         ean             = ?,
3284         agerestriction  = ?
3285         ";
3286     my $sth = $dbh->prepare($query);
3287     $sth->execute(
3288         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3289         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3290         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3291         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3292         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3293         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3294         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3295         $biblioitem->{'totalissues'},      $biblioitem->{'ean'},              $biblioitem->{'agerestriction'}
3296     );
3297     my $bibitemnum = $dbh->{'mysql_insertid'};
3298
3299     if ( $dbh->errstr ) {
3300         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3301         warn $error;
3302     }
3303     $sth->finish();
3304     return ( $bibitemnum, $error );
3305 }
3306
3307 =head2 _koha_delete_biblio
3308
3309   $error = _koha_delete_biblio($dbh,$biblionumber);
3310
3311 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3312
3313 C<$dbh> - the database handle
3314
3315 C<$biblionumber> - the biblionumber of the biblio to be deleted
3316
3317 =cut
3318
3319 # FIXME: add error handling
3320
3321 sub _koha_delete_biblio {
3322     my ( $dbh, $biblionumber ) = @_;
3323
3324     # get all the data for this biblio
3325     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3326     $sth->execute($biblionumber);
3327
3328     if ( my $data = $sth->fetchrow_hashref ) {
3329
3330         # save the record in deletedbiblio
3331         # find the fields to save
3332         my $query = "INSERT INTO deletedbiblio SET ";
3333         my @bind  = ();
3334         foreach my $temp ( keys %$data ) {
3335             $query .= "$temp = ?,";
3336             push( @bind, $data->{$temp} );
3337         }
3338
3339         # replace the last , by ",?)"
3340         $query =~ s/\,$//;
3341         my $bkup_sth = $dbh->prepare($query);
3342         $bkup_sth->execute(@bind);
3343         $bkup_sth->finish;
3344
3345         # delete the biblio
3346         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3347         $sth2->execute($biblionumber);
3348         # update the timestamp (Bugzilla 7146)
3349         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3350         $sth2->execute($biblionumber);
3351         $sth2->finish;
3352     }
3353     $sth->finish;
3354     return;
3355 }
3356
3357 =head2 _koha_delete_biblioitems
3358
3359   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3360
3361 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3362
3363 C<$dbh> - the database handle
3364 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3365
3366 =cut
3367
3368 # FIXME: add error handling
3369
3370 sub _koha_delete_biblioitems {
3371     my ( $dbh, $biblioitemnumber ) = @_;
3372
3373     # get all the data for this biblioitem
3374     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3375     $sth->execute($biblioitemnumber);
3376
3377     if ( my $data = $sth->fetchrow_hashref ) {
3378
3379         # save the record in deletedbiblioitems
3380         # find the fields to save
3381         my $query = "INSERT INTO deletedbiblioitems SET ";
3382         my @bind  = ();
3383         foreach my $temp ( keys %$data ) {
3384             $query .= "$temp = ?,";
3385             push( @bind, $data->{$temp} );
3386         }
3387
3388         # replace the last , by ",?)"
3389         $query =~ s/\,$//;
3390         my $bkup_sth = $dbh->prepare($query);
3391         $bkup_sth->execute(@bind);
3392         $bkup_sth->finish;
3393
3394         # delete the biblioitem
3395         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3396         $sth2->execute($biblioitemnumber);
3397         # update the timestamp (Bugzilla 7146)
3398         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3399         $sth2->execute($biblioitemnumber);
3400         $sth2->finish;
3401     }
3402     $sth->finish;
3403     return;
3404 }
3405
3406 =head1 UNEXPORTED FUNCTIONS
3407
3408 =head2 ModBiblioMarc
3409
3410   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3411
3412 Add MARC data for a biblio to koha
3413
3414 Function exported, but should NOT be used, unless you really know what you're doing
3415
3416 =cut
3417
3418 sub ModBiblioMarc {
3419     # pass the MARC::Record to this function, and it will create the records in
3420     # the marc field
3421     my ( $record, $biblionumber, $frameworkcode ) = @_;
3422     if ( !$record ) {
3423         carp 'ModBiblioMarc passed an undefined record';
3424         return;
3425     }
3426
3427     # Clone record as it gets modified
3428     $record = $record->clone();
3429     my $dbh    = C4::Context->dbh;
3430     my @fields = $record->fields();
3431     if ( !$frameworkcode ) {
3432         $frameworkcode = "";
3433     }
3434     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3435     $sth->execute( $frameworkcode, $biblionumber );
3436     $sth->finish;
3437     my $encoding = C4::Context->preference("marcflavour");
3438
3439     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3440     if ( $encoding eq "UNIMARC" ) {
3441         my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
3442         $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
3443         my $string = $record->subfield( 100, "a" );
3444         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3445             my $f100 = $record->field(100);
3446             $record->delete_field($f100);
3447         } else {
3448             $string = POSIX::strftime( "%Y%m%d", localtime );
3449             $string =~ s/\-//g;
3450             $string = sprintf( "%-*s", 35, $string );
3451             substr ( $string, 22, 3, $defaultlanguage);
3452         }
3453         substr( $string, 25, 3, "y50" );
3454         unless ( $record->subfield( 100, "a" ) ) {
3455             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3456         }
3457     }
3458
3459     #enhancement 5374: update transaction date (005) for marc21/unimarc
3460     if($encoding =~ /MARC21|UNIMARC/) {
3461       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3462         # YY MM DD HH MM SS (update year and month)
3463       my $f005= $record->field('005');
3464       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3465     }
3466
3467     $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3468     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3469     $sth->finish;
3470     ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
3471     return $biblionumber;
3472 }
3473
3474 =head2 get_biblio_authorised_values
3475
3476 find the types and values for all authorised values assigned to this biblio.
3477
3478 parameters:
3479     biblionumber
3480     MARC::Record of the bib
3481
3482 returns: a hashref mapping the authorised value to the value set for this biblionumber
3483
3484   $authorised_values = {
3485                        'Scent'     => 'flowery',
3486                        'Audience'  => 'Young Adult',
3487                        'itemtypes' => 'SER',
3488                         };
3489
3490 Notes: forlibrarian should probably be passed in, and called something different.
3491
3492 =cut
3493
3494 sub get_biblio_authorised_values {
3495     my $biblionumber = shift;
3496     my $record       = shift;
3497
3498     my $forlibrarian  = 1;                                 # are we in staff or opac?
3499     my $frameworkcode = GetFrameworkCode($biblionumber);
3500
3501     my $authorised_values;
3502
3503     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3504       or return $authorised_values;
3505
3506     # assume that these entries in the authorised_value table are bibliolevel.
3507     # ones that start with 'item%' are item level.
3508     my $query = q(SELECT distinct authorised_value, kohafield
3509                     FROM marc_subfield_structure
3510                     WHERE authorised_value !=''
3511                       AND (kohafield like 'biblio%'
3512                        OR  kohafield like '') );
3513     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3514
3515     foreach my $tag ( keys(%$tagslib) ) {
3516         foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3517
3518             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3519             if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3520                 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3521                     if ( defined $record->field($tag) ) {
3522                         my $this_subfield_value = $record->field($tag)->subfield($subfield);
3523                         if ( defined $this_subfield_value ) {
3524                             $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3525                         }
3526                     }
3527                 }
3528             }
3529         }
3530     }
3531
3532     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3533     return $authorised_values;
3534 }
3535
3536 =head2 CountBiblioInOrders
3537
3538     $count = &CountBiblioInOrders( $biblionumber);
3539
3540 This function return count of biblios in orders with $biblionumber
3541
3542 =cut
3543
3544 sub CountBiblioInOrders {
3545  my ($biblionumber) = @_;
3546     my $dbh            = C4::Context->dbh;
3547     my $query          = "SELECT count(*)
3548           FROM  aqorders
3549           WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3550     my $sth = $dbh->prepare($query);
3551     $sth->execute($biblionumber);
3552     my $count = $sth->fetchrow;
3553     return ($count);
3554 }
3555
3556 =head2 GetSubscriptionsId
3557
3558     $subscriptions = &GetSubscriptionsId($biblionumber);
3559
3560 This function return an array of subscriptionid with $biblionumber
3561
3562 =cut
3563
3564 sub GetSubscriptionsId {
3565  my ($biblionumber) = @_;
3566     my $dbh            = C4::Context->dbh;
3567     my $query          = "SELECT subscriptionid
3568           FROM  subscription
3569           WHERE biblionumber=?";
3570     my $sth = $dbh->prepare($query);
3571     $sth->execute($biblionumber);
3572     my @subscriptions = $sth->fetchrow_array;
3573     return (@subscriptions);
3574 }
3575
3576 =head2 GetHolds
3577
3578     $holds = &GetHolds($biblionumber);
3579
3580 This function return the count of holds with $biblionumber
3581
3582 =cut
3583
3584 sub GetHolds {
3585  my ($biblionumber) = @_;
3586     my $dbh            = C4::Context->dbh;
3587     my $query          = "SELECT count(*)
3588           FROM  reserves
3589           WHERE biblionumber=?";
3590     my $sth = $dbh->prepare($query);
3591     $sth->execute($biblionumber);
3592     my $holds = $sth->fetchrow;
3593     return ($holds);
3594 }
3595
3596 =head2 prepare_host_field
3597
3598 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3599 Generate the host item entry for an analytic child entry
3600
3601 =cut
3602
3603 sub prepare_host_field {
3604     my ( $hostbiblio, $marcflavour ) = @_;
3605     $marcflavour ||= C4::Context->preference('marcflavour');
3606     my $host = GetMarcBiblio($hostbiblio);
3607     # unfortunately as_string does not 'do the right thing'
3608     # if field returns undef
3609     my %sfd;
3610     my $field;
3611     my $host_field;
3612     if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3613         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3614             my $s = $field->as_string('ab');
3615             if ($s) {
3616                 $sfd{a} = $s;
3617             }
3618         }
3619         if ( $field = $host->field('245') ) {
3620             my $s = $field->as_string('a');
3621             if ($s) {
3622                 $sfd{t} = $s;
3623             }
3624         }
3625         if ( $field = $host->field('260') ) {
3626             my $s = $field->as_string('abc');
3627             if ($s) {
3628                 $sfd{d} = $s;
3629             }
3630         }
3631         if ( $field = $host->field('240') ) {
3632             my $s = $field->as_string();
3633             if ($s) {
3634                 $sfd{b} = $s;
3635             }
3636         }
3637         if ( $field = $host->field('022') ) {
3638             my $s = $field->as_string('a');
3639             if ($s) {
3640                 $sfd{x} = $s;
3641             }
3642         }
3643         if ( $field = $host->field('020') ) {
3644             my $s = $field->as_string('a');
3645             if ($s) {
3646                 $sfd{z} = $s;
3647             }
3648         }
3649         if ( $field = $host->field('001') ) {
3650             $sfd{w} = $field->data(),;
3651         }
3652         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3653         return $host_field;
3654     }
3655     elsif ( $marcflavour eq 'UNIMARC' ) {
3656         #author
3657         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3658             my $s = $field->as_string('ab');
3659             if ($s) {
3660                 $sfd{a} = $s;
3661             }
3662         }
3663         #title
3664         if ( $field = $host->field('200') ) {
3665             my $s = $field->as_string('a');
3666             if ($s) {
3667                 $sfd{t} = $s;
3668             }
3669         }
3670         #place of publicaton
3671         if ( $field = $host->field('210') ) {
3672             my $s = $field->as_string('a');
3673             if ($s) {
3674                 $sfd{c} = $s;
3675             }
3676         }
3677         #date of publication
3678         if ( $field = $host->field('210') ) {
3679             my $s = $field->as_string('d');
3680             if ($s) {
3681                 $sfd{d} = $s;
3682             }
3683         }
3684         #edition statement
3685         if ( $field = $host->field('205') ) {
3686             my $s = $field->as_string();
3687             if ($s) {
3688                 $sfd{e} = $s;
3689             }
3690         }
3691         #URL
3692         if ( $field = $host->field('856') ) {
3693             my $s = $field->as_string('u');
3694             if ($s) {
3695                 $sfd{u} = $s;
3696             }
3697         }
3698         #ISSN
3699         if ( $field = $host->field('011') ) {
3700             my $s = $field->as_string('a');
3701             if ($s) {
3702                 $sfd{x} = $s;
3703             }
3704         }
3705         #ISBN
3706         if ( $field = $host->field('010') ) {
3707             my $s = $field->as_string('a');
3708             if ($s) {
3709                 $sfd{y} = $s;
3710             }
3711         }
3712         if ( $field = $host->field('001') ) {
3713             $sfd{0} = $field->data(),;
3714         }
3715         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3716         return $host_field;
3717     }
3718     return;
3719 }
3720
3721
3722 =head2 UpdateTotalIssues
3723
3724   UpdateTotalIssues($biblionumber, $increase, [$value])
3725
3726 Update the total issue count for a particular bib record.
3727
3728 =over 4
3729
3730 =item C<$biblionumber> is the biblionumber of the bib to update
3731
3732 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3733
3734 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3735
3736 =back
3737
3738 =cut
3739
3740 sub UpdateTotalIssues {
3741     my ($biblionumber, $increase, $value) = @_;
3742     my $totalissues;
3743
3744     my $record = GetMarcBiblio($biblionumber);
3745     unless ($record) {
3746         carp "UpdateTotalIssues could not get biblio record";
3747         return;
3748     }
3749     my $data = GetBiblioData($biblionumber);
3750     unless ($data) {
3751         carp "UpdateTotalIssues could not get datas of biblio";
3752         return;
3753     }
3754     my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
3755     unless ($totalissuestag) {
3756         return 1; # There is nothing to do
3757     }
3758
3759     if (defined $value) {
3760         $totalissues = $value;
3761     } else {
3762         $totalissues = $data->{'totalissues'} + $increase;
3763     }
3764
3765      my $field = $record->field($totalissuestag);
3766      if (defined $field) {
3767          $field->update( $totalissuessubfield => $totalissues );
3768      } else {
3769          $field = MARC::Field->new($totalissuestag, '0', '0',
3770                  $totalissuessubfield => $totalissues);
3771          $record->insert_grouped_field($field);
3772      }
3773
3774      return ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
3775 }
3776
3777 =head2 RemoveAllNsb
3778
3779     &RemoveAllNsb($record);
3780
3781 Removes all nsb/nse chars from a record
3782
3783 =cut
3784
3785 sub RemoveAllNsb {
3786     my $record = shift;
3787     if (!$record) {
3788         carp 'RemoveAllNsb called with undefined record';
3789         return;
3790     }
3791
3792     SetUTF8Flag($record);
3793
3794     foreach my $field ($record->fields()) {
3795         if ($field->is_control_field()) {
3796             $field->update(nsb_clean($field->data()));
3797         } else {
3798             my @subfields = $field->subfields();
3799             my @new_subfields;
3800             foreach my $subfield (@subfields) {
3801                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3802             }
3803             if (scalar(@new_subfields) > 0) {
3804                 my $new_field;
3805                 eval {
3806                     $new_field = MARC::Field->new(
3807                         $field->tag(),
3808                         $field->indicator(1),
3809                         $field->indicator(2),
3810                         @new_subfields
3811                     );
3812                 };
3813                 if ($@) {
3814                     warn "error in RemoveAllNsb : $@";
3815                 } else {
3816                     $field->replace_with($new_field);
3817                 }
3818             }
3819         }
3820     }
3821
3822     return $record;
3823 }
3824
3825 1;
3826
3827
3828 __END__
3829
3830 =head1 AUTHOR
3831
3832 Koha Development Team <http://koha-community.org/>
3833
3834 Paul POULAIN paul.poulain@free.fr
3835
3836 Joshua Ferraro jmf@liblime.com
3837
3838 =cut