C4/Biblio.pm

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