C4/Biblio.pm

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