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