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