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