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