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