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