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