C4/Biblio.pm

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