C4/Biblio.pm

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