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 or default framework if $frameworkcode is missing
1203
1204 =cut
1205
1206 sub GetMarcFromKohaField {
1207     my $kohafield = shift;
1208     my $frameworkcode = shift || '';
1209     return (0, undef) unless $kohafield;
1210     my $relations = C4::Context->marcfromkohafield;
1211     if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
1212         return @$mf;
1213     }
1214     return (0, undef);
1215 }
1216
1217 =head2 GetMarcBiblio
1218
1219   my $record = GetMarcBiblio($biblionumber, [$embeditems]);
1220
1221 Returns MARC::Record representing bib identified by
1222 C<$biblionumber>.  If no bib exists, returns undef.
1223 C<$embeditems>.  If set to true, items data are included.
1224 The MARC record contains biblio data, and items data if $embeditems is set to true.
1225
1226 =cut
1227
1228 sub GetMarcBiblio {
1229     my $biblionumber = shift;
1230     my $embeditems   = shift || 0;
1231     my $dbh          = C4::Context->dbh;
1232     my $sth          = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1233     $sth->execute($biblionumber);
1234     my $row     = $sth->fetchrow_hashref;
1235     my $marcxml = StripNonXmlChars( $row->{'marcxml'} );
1236     MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
1237     my $record = MARC::Record->new();
1238
1239     if ($marcxml) {
1240         $record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
1241         if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
1242         return unless $record;
1243
1244         C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber);
1245         C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
1246
1247         return $record;
1248     } else {
1249         return;
1250     }
1251 }
1252
1253 =head2 GetXmlBiblio
1254
1255   my $marcxml = GetXmlBiblio($biblionumber);
1256
1257 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1258 The XML should only contain biblio information (item information is no longer stored in marcxml field)
1259
1260 =cut
1261
1262 sub GetXmlBiblio {
1263     my ($biblionumber) = @_;
1264     my $dbh            = C4::Context->dbh;
1265     my $sth            = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1266     $sth->execute($biblionumber);
1267     my ($marcxml) = $sth->fetchrow;
1268     return $marcxml;
1269 }
1270
1271 =head2 GetCOinSBiblio
1272
1273   my $coins = GetCOinSBiblio($record);
1274
1275 Returns the COinS (a span) which can be included in a biblio record
1276
1277 =cut
1278
1279 sub GetCOinSBiblio {
1280     my $record = shift;
1281
1282     # get the coin format
1283     if ( ! $record ) {
1284         return;
1285     }
1286     my $pos7 = substr $record->leader(), 7, 1;
1287     my $pos6 = substr $record->leader(), 6, 1;
1288     my $mtx;
1289     my $genre;
1290     my ( $aulast, $aufirst ) = ( '', '' );
1291     my $oauthors  = '';
1292     my $title     = '';
1293     my $subtitle  = '';
1294     my $pubyear   = '';
1295     my $isbn      = '';
1296     my $issn      = '';
1297     my $publisher = '';
1298     my $pages     = '';
1299     my $titletype = 'b';
1300
1301     # For the purposes of generating COinS metadata, LDR/06-07 can be
1302     # considered the same for UNIMARC and MARC21
1303     my $fmts6;
1304     my $fmts7;
1305     %$fmts6 = (
1306                 'a' => 'book',
1307                 'b' => 'manuscript',
1308                 'c' => 'book',
1309                 'd' => 'manuscript',
1310                 'e' => 'map',
1311                 'f' => 'map',
1312                 'g' => 'film',
1313                 'i' => 'audioRecording',
1314                 'j' => 'audioRecording',
1315                 'k' => 'artwork',
1316                 'l' => 'document',
1317                 'm' => 'computerProgram',
1318                 'o' => 'document',
1319                 'r' => 'document',
1320             );
1321     %$fmts7 = (
1322                     'a' => 'journalArticle',
1323                     's' => 'journal',
1324               );
1325
1326     $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
1327
1328     if ( $genre eq 'book' ) {
1329             $genre = $fmts7->{$pos7} if $fmts7->{$pos7};
1330     }
1331
1332     ##### We must transform mtx to a valable mtx and document type ####
1333     if ( $genre eq 'book' ) {
1334             $mtx = 'book';
1335     } elsif ( $genre eq 'journal' ) {
1336             $mtx = 'journal';
1337             $titletype = 'j';
1338     } elsif ( $genre eq 'journalArticle' ) {
1339             $mtx   = 'journal';
1340             $genre = 'article';
1341             $titletype = 'a';
1342     } else {
1343             $mtx = 'dc';
1344     }
1345
1346     $genre = ( $mtx eq 'dc' ) ? "&amp;rft.type=$genre" : "&amp;rft.genre=$genre";
1347
1348     if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
1349
1350         # Setting datas
1351         $aulast  = $record->subfield( '700', 'a' ) || '';
1352         $aufirst = $record->subfield( '700', 'b' ) || '';
1353         $oauthors = "&amp;rft.au=$aufirst $aulast";
1354
1355         # others authors
1356         if ( $record->field('200') ) {
1357             for my $au ( $record->field('200')->subfield('g') ) {
1358                 $oauthors .= "&amp;rft.au=$au";
1359             }
1360         }
1361         $title =
1362           ( $mtx eq 'dc' )
1363           ? "&amp;rft.title=" . $record->subfield( '200', 'a' )
1364           : "&amp;rft.title=" . $record->subfield( '200', 'a' ) . "&amp;rft.btitle=" . $record->subfield( '200', 'a' );
1365         $pubyear   = $record->subfield( '210', 'd' ) || '';
1366         $publisher = $record->subfield( '210', 'c' ) || '';
1367         $isbn      = $record->subfield( '010', 'a' ) || '';
1368         $issn      = $record->subfield( '011', 'a' ) || '';
1369     } else {
1370
1371         # MARC21 need some improve
1372
1373         # Setting datas
1374         if ( $record->field('100') ) {
1375             $oauthors .= "&amp;rft.au=" . $record->subfield( '100', 'a' );
1376         }
1377
1378         # others authors
1379         if ( $record->field('700') ) {
1380             for my $au ( $record->field('700')->subfield('a') ) {
1381                 $oauthors .= "&amp;rft.au=$au";
1382             }
1383         }
1384         $title = "&amp;rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
1385         $subtitle = $record->subfield( '245', 'b' ) || '';
1386         $title .= $subtitle;
1387         if ($titletype eq 'a') {
1388             $pubyear   = $record->field('008') || '';
1389             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
1390             $isbn      = $record->subfield( '773', 'z' ) || '';
1391             $issn      = $record->subfield( '773', 'x' ) || '';
1392             if ($mtx eq 'journal') {
1393                 $title    .= "&amp;rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1394             } else {
1395                 $title    .= "&amp;rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1396             }
1397             foreach my $rel ($record->subfield( '773', 'g' )) {
1398                 if ($pages) {
1399                     $pages .= ', ';
1400                 }
1401                 $pages .= $rel;
1402             }
1403         } else {
1404             $pubyear   = $record->subfield( '260', 'c' ) || '';
1405             $publisher = $record->subfield( '260', 'b' ) || '';
1406             $isbn      = $record->subfield( '020', 'a' ) || '';
1407             $issn      = $record->subfield( '022', 'a' ) || '';
1408         }
1409
1410     }
1411     my $coins_value =
1412 "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";
1413     $coins_value =~ s/(\ |&[^a])/\+/g;
1414     $coins_value =~ s/\"/\&quot\;/g;
1415
1416 #<!-- 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="
1417
1418     return $coins_value;
1419 }
1420
1421
1422 =head2 GetMarcPrice
1423
1424 return the prices in accordance with the Marc format.
1425 =cut
1426
1427 sub GetMarcPrice {
1428     my ( $record, $marcflavour ) = @_;
1429     my @listtags;
1430     my $subfield;
1431
1432     if ( $marcflavour eq "MARC21" ) {
1433         @listtags = ('345', '020');
1434         $subfield="c";
1435     } elsif ( $marcflavour eq "UNIMARC" ) {
1436         @listtags = ('345', '010');
1437         $subfield="d";
1438     } else {
1439         return;
1440     }
1441
1442     for my $field ( $record->field(@listtags) ) {
1443         for my $subfield_value  ($field->subfield($subfield)){
1444             #check value
1445             $subfield_value = MungeMarcPrice( $subfield_value );
1446             return $subfield_value if ($subfield_value);
1447         }
1448     }
1449     return 0; # no price found
1450 }
1451
1452 =head2 MungeMarcPrice
1453
1454 Return the best guess at what the actual price is from a price field.
1455 =cut
1456
1457 sub MungeMarcPrice {
1458     my ( $price ) = @_;
1459
1460     return unless ( $price =~ m/\d/ ); ## No digits means no price.
1461
1462     ## Look for the currency symbol of the active currency, if it's there,
1463     ## start the price string right after the symbol. This allows us to prefer
1464     ## this native currency price over other currency prices, if possible.
1465     my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} );
1466     my $symbol = quotemeta( $active_currency->{'symbol'} );
1467     if ( $price =~ m/$symbol/ ) {
1468         my @parts = split(/$symbol/, $price );
1469         $price = $parts[1];
1470     }
1471
1472     ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1473     ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1474
1475     ## Split price into array on periods and commas
1476     my @parts = split(/[\,\.]/, $price);
1477
1478     ## If the last grouping of digits is more than 2 characters, assume there is no decimal value and put it back.
1479     my $decimal = pop( @parts );
1480     if ( length( $decimal ) > 2 ) {
1481         push( @parts, $decimal );
1482         $decimal = '';
1483     }
1484
1485     $price = join('', @parts );
1486
1487     if ( $decimal ) {
1488      $price .= ".$decimal";
1489     }
1490
1491     return $price;
1492 }
1493
1494
1495 =head2 GetMarcQuantity
1496
1497 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1498 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1499
1500 =cut
1501
1502 sub GetMarcQuantity {
1503     my ( $record, $marcflavour ) = @_;
1504     my @listtags;
1505     my $subfield;
1506
1507     if ( $marcflavour eq "MARC21" ) {
1508         return 0
1509     } elsif ( $marcflavour eq "UNIMARC" ) {
1510         @listtags = ('969');
1511         $subfield="a";
1512     } else {
1513         return;
1514     }
1515
1516     for my $field ( $record->field(@listtags) ) {
1517         for my $subfield_value  ($field->subfield($subfield)){
1518             #check value
1519             if ($subfield_value) {
1520                  # in France, the cents separator is the , but sometimes, ppl use a .
1521                  # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1522                 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1523                 return $subfield_value;
1524             }
1525         }
1526     }
1527     return 0; # no price found
1528 }
1529
1530
1531 =head2 GetAuthorisedValueDesc
1532
1533   my $subfieldvalue =get_authorised_value_desc(
1534     $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1535
1536 Retrieve the complete description for a given authorised value.
1537
1538 Now takes $category and $value pair too.
1539
1540   my $auth_value_desc =GetAuthorisedValueDesc(
1541     '','', 'DVD' ,'','','CCODE');
1542
1543 If the optional $opac parameter is set to a true value, displays OPAC
1544 descriptions rather than normal ones when they exist.
1545
1546 =cut
1547
1548 sub GetAuthorisedValueDesc {
1549     my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1550     my $dbh = C4::Context->dbh;
1551
1552     if ( !$category ) {
1553
1554         return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1555
1556         #---- branch
1557         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1558             return C4::Branch::GetBranchName($value);
1559         }
1560
1561         #---- itemtypes
1562         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1563             return getitemtypeinfo($value)->{description};
1564         }
1565
1566         #---- "true" authorized value
1567         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1568     }
1569
1570     if ( $category ne "" ) {
1571         my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1572         $sth->execute( $category, $value );
1573         my $data = $sth->fetchrow_hashref;
1574         return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1575     } else {
1576         return $value;    # if nothing is found return the original value
1577     }
1578 }
1579
1580 =head2 GetMarcControlnumber
1581
1582   $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1583
1584 Get the control number / record Identifier from the MARC record and return it.
1585
1586 =cut
1587
1588 sub GetMarcControlnumber {
1589     my ( $record, $marcflavour ) = @_;
1590     my $controlnumber = "";
1591     # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
1592     # Keep $marcflavour for possible later use
1593     if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
1594         my $controlnumberField = $record->field('001');
1595         if ($controlnumberField) {
1596             $controlnumber = $controlnumberField->data();
1597         }
1598     }
1599     return $controlnumber;
1600 }
1601
1602 =head2 GetMarcISBN
1603
1604   $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1605
1606 Get all ISBNs from the MARC record and returns them in an array.
1607 ISBNs stored in different fields depending on MARC flavour
1608
1609 =cut
1610
1611 sub GetMarcISBN {
1612     my ( $record, $marcflavour ) = @_;
1613     my $scope;
1614     if ( $marcflavour eq "UNIMARC" ) {
1615         $scope = '010';
1616     } else {    # assume marc21 if not unimarc
1617         $scope = '020';
1618     }
1619     my @marcisbns;
1620     my $isbn = "";
1621     my $tag  = "";
1622     my $marcisbn;
1623     foreach my $field ( $record->field($scope) ) {
1624         my $value = $field->as_string();
1625         if ( $isbn ne "" ) {
1626             $marcisbn = { marcisbn => $isbn, };
1627             push @marcisbns, $marcisbn;
1628             $isbn = $value;
1629         }
1630         if ( $isbn ne $value ) {
1631             $isbn = $isbn . " " . $value;
1632         }
1633     }
1634
1635     if ($isbn) {
1636         $marcisbn = { marcisbn => $isbn };
1637         push @marcisbns, $marcisbn;    #load last tag into array
1638     }
1639     return \@marcisbns;
1640 }    # end GetMarcISBN
1641
1642
1643 =head2 GetMarcISSN
1644
1645   $marcissnsarray = GetMarcISSN( $record, $marcflavour );
1646
1647 Get all valid ISSNs from the MARC record and returns them in an array.
1648 ISSNs are stored in different fields depending on MARC flavour
1649
1650 =cut
1651
1652 sub GetMarcISSN {
1653     my ( $record, $marcflavour ) = @_;
1654     my $scope;
1655     if ( $marcflavour eq "UNIMARC" ) {
1656         $scope = '011';
1657     }
1658     else {    # assume MARC21 or NORMARC
1659         $scope = '022';
1660     }
1661     my @marcissns;
1662     foreach my $field ( $record->field($scope) ) {
1663         push @marcissns, $field->subfield( 'a' );
1664     }
1665     return \@marcissns;
1666 }    # end GetMarcISSN
1667
1668 =head2 GetMarcNotes
1669
1670   $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1671
1672 Get all notes from the MARC record and returns them in an array.
1673 The note are stored in different fields depending on MARC flavour
1674
1675 =cut
1676
1677 sub GetMarcNotes {
1678     my ( $record, $marcflavour ) = @_;
1679     my $scope;
1680     if ( $marcflavour eq "UNIMARC" ) {
1681         $scope = '3..';
1682     } else {    # assume marc21 if not unimarc
1683         $scope = '5..';
1684     }
1685     my @marcnotes;
1686     my $note = "";
1687     my $tag  = "";
1688     my $marcnote;
1689     foreach my $field ( $record->field($scope) ) {
1690         my $value = $field->as_string();
1691         if ( $note ne "" ) {
1692             $marcnote = { marcnote => $note, };
1693             push @marcnotes, $marcnote;
1694             $note = $value;
1695         }
1696         if ( $note ne $value ) {
1697             $note = $note . " " . $value;
1698         }
1699     }
1700
1701     if ($note) {
1702         $marcnote = { marcnote => $note };
1703         push @marcnotes, $marcnote;    #load last tag into array
1704     }
1705     return \@marcnotes;
1706 }    # end GetMarcNotes
1707
1708 =head2 GetMarcSubjects
1709
1710   $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1711
1712 Get all subjects from the MARC record and returns them in an array.
1713 The subjects are stored in different fields depending on MARC flavour
1714
1715 =cut
1716
1717 sub GetMarcSubjects {
1718     my ( $record, $marcflavour ) = @_;
1719     my ( $mintag, $maxtag, $fields_filter );
1720     if ( $marcflavour eq "UNIMARC" ) {
1721         $mintag = "600";
1722         $maxtag = "611";
1723         $fields_filter = '6..';
1724     } else { # marc21/normarc
1725         $mintag = "600";
1726         $maxtag = "699";
1727         $fields_filter = '6..';
1728     }
1729
1730     my @marcsubjects;
1731
1732     my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1733     my $authoritysep = C4::Context->preference('authoritysep');
1734
1735     foreach my $field ( $record->field($fields_filter) ) {
1736         next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
1737         my @subfields_loop;
1738         my @subfields = $field->subfields();
1739         my @link_loop;
1740
1741         # if there is an authority link, build the links with an= subfield9
1742         my $subfield9 = $field->subfield('9');
1743         my $authoritylink;
1744         if ($subfield9) {
1745             my $linkvalue = $subfield9;
1746             $linkvalue =~ s/(\(|\))//g;
1747             @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
1748             $authoritylink = $linkvalue
1749         }
1750
1751         # other subfields
1752         for my $subject_subfield (@subfields) {
1753             next if ( $subject_subfield->[0] eq '9' );
1754
1755             # don't load unimarc subfields 3,4,5
1756             next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1757             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1758             next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1759
1760             my $code      = $subject_subfield->[0];
1761             my $value     = $subject_subfield->[1];
1762             my $linkvalue = $value;
1763             $linkvalue =~ s/(\(|\))//g;
1764             # if no authority link, build a search query
1765             unless ($subfield9) {
1766                 push @link_loop, {
1767                     limit    => $subject_limit,
1768                     'link'   => $linkvalue,
1769                     operator => (scalar @link_loop) ? ' and ' : undef
1770                 };
1771             }
1772             my @this_link_loop = @link_loop;
1773             # do not display $0
1774             unless ( $code eq '0' ) {
1775                 push @subfields_loop, {
1776                     code      => $code,
1777                     value     => $value,
1778                     link_loop => \@this_link_loop,
1779                     separator => (scalar @subfields_loop) ? $authoritysep : ''
1780                 };
1781             }
1782         }
1783
1784         push @marcsubjects, {
1785             MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
1786             authoritylink => $authoritylink,
1787         };
1788
1789     }
1790     return \@marcsubjects;
1791 }    #end getMARCsubjects
1792
1793 =head2 GetMarcAuthors
1794
1795   authors = GetMarcAuthors($record,$marcflavour);
1796
1797 Get all authors from the MARC record and returns them in an array.
1798 The authors are stored in different fields depending on MARC flavour
1799
1800 =cut
1801
1802 sub GetMarcAuthors {
1803     my ( $record, $marcflavour ) = @_;
1804     my ( $mintag, $maxtag, $fields_filter );
1805
1806     # tagslib useful for UNIMARC author reponsabilities
1807     my $tagslib =
1808       &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.
1809     if ( $marcflavour eq "UNIMARC" ) {
1810         $mintag = "700";
1811         $maxtag = "712";
1812         $fields_filter = '7..';
1813     } else { # marc21/normarc
1814         $mintag = "700";
1815         $maxtag = "720";
1816         $fields_filter = '7..';
1817     }
1818
1819     my @marcauthors;
1820     my $authoritysep = C4::Context->preference('authoritysep');
1821
1822     foreach my $field ( $record->field($fields_filter) ) {
1823         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1824         my @subfields_loop;
1825         my @link_loop;
1826         my @subfields  = $field->subfields();
1827         my $count_auth = 0;
1828
1829         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1830         my $subfield9 = $field->subfield('9');
1831         if ($subfield9) {
1832             my $linkvalue = $subfield9;
1833             $linkvalue =~ s/(\(|\))//g;
1834             @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
1835         }
1836
1837         # other subfields
1838         for my $authors_subfield (@subfields) {
1839             next if ( $authors_subfield->[0] eq '9' );
1840
1841             # don't load unimarc subfields 3, 5
1842             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1843
1844             my $code = $authors_subfield->[0];
1845             my $value        = $authors_subfield->[1];
1846             my $linkvalue    = $value;
1847             $linkvalue =~ s/(\(|\))//g;
1848             # UNIMARC author responsibility
1849             if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
1850                 $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
1851                 $linkvalue = "($value)";
1852             }
1853             # if no authority link, build a search query
1854             unless ($subfield9) {
1855                 push @link_loop, {
1856                     limit    => 'au',
1857                     'link'   => $linkvalue,
1858                     operator => (scalar @link_loop) ? ' and ' : undef
1859                 };
1860             }
1861             my @this_link_loop = @link_loop;
1862             # do not display $0
1863             unless ( $code eq '0') {
1864                 push @subfields_loop, {
1865                     tag       => $field->tag(),
1866                     code      => $code,
1867                     value     => $value,
1868                     link_loop => \@this_link_loop,
1869                     separator => (scalar @subfields_loop) ? $authoritysep : ''
1870                 };
1871             }
1872         }
1873         push @marcauthors, {
1874             MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
1875             authoritylink => $subfield9,
1876         };
1877     }
1878     return \@marcauthors;
1879 }
1880
1881 =head2 GetMarcUrls
1882
1883   $marcurls = GetMarcUrls($record,$marcflavour);
1884
1885 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1886 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1887
1888 =cut
1889
1890 sub GetMarcUrls {
1891     my ( $record, $marcflavour ) = @_;
1892
1893     my @marcurls;
1894     for my $field ( $record->field('856') ) {
1895         my @notes;
1896         for my $note ( $field->subfield('z') ) {
1897             push @notes, { note => $note };
1898         }
1899         my @urls = $field->subfield('u');
1900         foreach my $url (@urls) {
1901             my $marcurl;
1902             if ( $marcflavour eq 'MARC21' ) {
1903                 my $s3   = $field->subfield('3');
1904                 my $link = $field->subfield('y');
1905                 unless ( $url =~ /^\w+:/ ) {
1906                     if ( $field->indicator(1) eq '7' ) {
1907                         $url = $field->subfield('2') . "://" . $url;
1908                     } elsif ( $field->indicator(1) eq '1' ) {
1909                         $url = 'ftp://' . $url;
1910                     } else {
1911
1912                         #  properly, this should be if ind1=4,
1913                         #  however we will assume http protocol since we're building a link.
1914                         $url = 'http://' . $url;
1915                     }
1916                 }
1917
1918                 # TODO handle ind 2 (relationship)
1919                 $marcurl = {
1920                     MARCURL => $url,
1921                     notes   => \@notes,
1922                 };
1923                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1924                 $marcurl->{'part'} = $s3 if ($link);
1925                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1926             } else {
1927                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1928                 $marcurl->{'MARCURL'} = $url;
1929             }
1930             push @marcurls, $marcurl;
1931         }
1932     }
1933     return \@marcurls;
1934 }
1935
1936 =head2 GetMarcSeries
1937
1938   $marcseriesarray = GetMarcSeries($record,$marcflavour);
1939
1940 Get all series from the MARC record and returns them in an array.
1941 The series are stored in different fields depending on MARC flavour
1942
1943 =cut
1944
1945 sub GetMarcSeries {
1946     my ( $record, $marcflavour ) = @_;
1947     my ( $mintag, $maxtag, $fields_filter );
1948     if ( $marcflavour eq "UNIMARC" ) {
1949         $mintag = "600";
1950         $maxtag = "619";
1951         $fields_filter = '6..';
1952     } else {    # marc21/normarc
1953         $mintag = "440";
1954         $maxtag = "490";
1955         $fields_filter = '4..';
1956     }
1957
1958     my @marcseries;
1959     my $authoritysep = C4::Context->preference('authoritysep');
1960
1961     foreach my $field ( $record->field($fields_filter) ) {
1962         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1963         my @subfields_loop;
1964         my @subfields = $field->subfields();
1965         my @link_loop;
1966
1967         for my $series_subfield (@subfields) {
1968
1969             # ignore $9, used for authority link
1970             next if ( $series_subfield->[0] eq '9' );
1971
1972             my $volume_number;
1973             my $code      = $series_subfield->[0];
1974             my $value     = $series_subfield->[1];
1975             my $linkvalue = $value;
1976             $linkvalue =~ s/(\(|\))//g;
1977
1978             # see if this is an instance of a volume
1979             if ( $code eq 'v' ) {
1980                 $volume_number = 1;
1981             }
1982
1983             push @link_loop, {
1984                 'link' => $linkvalue,
1985                 operator => (scalar @link_loop) ? ' and ' : undef
1986             };
1987
1988             if ($volume_number) {
1989                 push @subfields_loop, { volumenum => $value };
1990             } else {
1991                 push @subfields_loop, {
1992                     code      => $code,
1993                     value     => $value,
1994                     link_loop => \@link_loop,
1995                     separator => (scalar @subfields_loop) ? $authoritysep : '',
1996                     volumenum => $volume_number,
1997                 }
1998             }
1999         }
2000         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2001
2002     }
2003     return \@marcseries;
2004 }    #end getMARCseriess
2005
2006 =head2 GetMarcHosts
2007
2008   $marchostsarray = GetMarcHosts($record,$marcflavour);
2009
2010 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
2011
2012 =cut
2013
2014 sub GetMarcHosts {
2015     my ( $record, $marcflavour ) = @_;
2016     my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
2017     $marcflavour ||="MARC21";
2018     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2019         $tag = "773";
2020         $title_subf = "t";
2021         $bibnumber_subf ="0";
2022         $itemnumber_subf='9';
2023     }
2024     elsif ($marcflavour eq "UNIMARC") {
2025         $tag = "461";
2026         $title_subf = "t";
2027         $bibnumber_subf ="0";
2028         $itemnumber_subf='9';
2029     };
2030
2031     my @marchosts;
2032
2033     foreach my $field ( $record->field($tag)) {
2034
2035         my @fields_loop;
2036
2037         my $hostbiblionumber = $field->subfield("$bibnumber_subf");
2038         my $hosttitle = $field->subfield($title_subf);
2039         my $hostitemnumber=$field->subfield($itemnumber_subf);
2040         push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
2041         push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
2042
2043         }
2044     my $marchostsarray = \@marchosts;
2045     return $marchostsarray;
2046 }
2047
2048 =head2 GetFrameworkCode
2049
2050   $frameworkcode = GetFrameworkCode( $biblionumber )
2051
2052 =cut
2053
2054 sub GetFrameworkCode {
2055     my ($biblionumber) = @_;
2056     my $dbh            = C4::Context->dbh;
2057     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2058     $sth->execute($biblionumber);
2059     my ($frameworkcode) = $sth->fetchrow;
2060     return $frameworkcode;
2061 }
2062
2063 =head2 TransformKohaToMarc
2064
2065     $record = TransformKohaToMarc( $hash )
2066
2067 This function builds partial MARC::Record from a hash
2068 Hash entries can be from biblio or biblioitems.
2069
2070 This function is called in acquisition module, to create a basic catalogue
2071 entry from user entry
2072
2073 =cut
2074
2075
2076 sub TransformKohaToMarc {
2077     my $hash = shift;
2078     my $record = MARC::Record->new();
2079     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
2080     my $db_to_marc = C4::Context->marcfromkohafield;
2081     while ( my ($name, $value) = each %$hash ) {
2082         next unless my $dtm = $db_to_marc->{''}->{$name};
2083         next unless ( scalar( @$dtm ) );
2084         my ($tag, $letter) = @$dtm;
2085         foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
2086             if ( my $field = $record->field($tag) ) {
2087                 $field->add_subfields( $letter => $value );
2088             }
2089             else {
2090                 $record->insert_fields_ordered( MARC::Field->new(
2091                     $tag, " ", " ", $letter => $value ) );
2092             }
2093         }
2094
2095     }
2096     return $record;
2097 }
2098
2099 =head2 PrepHostMarcField
2100
2101     $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
2102
2103 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
2104
2105 =cut
2106
2107 sub PrepHostMarcField {
2108     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
2109     $marcflavour ||="MARC21";
2110
2111     require C4::Items;
2112     my $hostrecord = GetMarcBiblio($hostbiblionumber);
2113         my $item = C4::Items::GetItem($hostitemnumber);
2114
2115         my $hostmarcfield;
2116     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
2117
2118         #main entry
2119         my $mainentry;
2120         if ($hostrecord->subfield('100','a')){
2121             $mainentry = $hostrecord->subfield('100','a');
2122         } elsif ($hostrecord->subfield('110','a')){
2123             $mainentry = $hostrecord->subfield('110','a');
2124         } else {
2125             $mainentry = $hostrecord->subfield('111','a');
2126         }
2127
2128         # qualification info
2129         my $qualinfo;
2130         if (my $field260 = $hostrecord->field('260')){
2131             $qualinfo =  $field260->as_string( 'abc' );
2132         }
2133
2134
2135         #other fields
2136         my $ed = $hostrecord->subfield('250','a');
2137         my $barcode = $item->{'barcode'};
2138         my $title = $hostrecord->subfield('245','a');
2139
2140         # record control number, 001 with 003 and prefix
2141         my $recctrlno;
2142         if ($hostrecord->field('001')){
2143             $recctrlno = $hostrecord->field('001')->data();
2144             if ($hostrecord->field('003')){
2145                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
2146             }
2147         }
2148
2149         # issn/isbn
2150         my $issn = $hostrecord->subfield('022','a');
2151         my $isbn = $hostrecord->subfield('020','a');
2152
2153
2154         $hostmarcfield = MARC::Field->new(
2155                 773, '0', '',
2156                 '0' => $hostbiblionumber,
2157                 '9' => $hostitemnumber,
2158                 'a' => $mainentry,
2159                 'b' => $ed,
2160                 'd' => $qualinfo,
2161                 'o' => $barcode,
2162                 't' => $title,
2163                 'w' => $recctrlno,
2164                 'x' => $issn,
2165                 'z' => $isbn
2166                 );
2167     } elsif ($marcflavour eq "UNIMARC") {
2168         $hostmarcfield = MARC::Field->new(
2169             461, '', '',
2170             '0' => $hostbiblionumber,
2171             't' => $hostrecord->subfield('200','a'),
2172             '9' => $hostitemnumber
2173         );
2174     };
2175
2176     return $hostmarcfield;
2177 }
2178
2179 =head2 TransformHtmlToXml
2180
2181   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
2182                              $ind_tag, $auth_type )
2183
2184 $auth_type contains :
2185
2186 =over
2187
2188 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
2189
2190 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2191
2192 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2193
2194 =back
2195
2196 =cut
2197
2198 sub TransformHtmlToXml {
2199     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2200     my $xml = MARC::File::XML::header('UTF-8');
2201     $xml .= "<record>\n";
2202     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2203     MARC::File::XML->default_record_format($auth_type);
2204
2205     # in UNIMARC, field 100 contains the encoding
2206     # check that there is one, otherwise the
2207     # MARC::Record->new_from_xml will fail (and Koha will die)
2208     my $unimarc_and_100_exist = 0;
2209     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
2210     my $prevvalue;
2211     my $prevtag = -1;
2212     my $first   = 1;
2213     my $j       = -1;
2214     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
2215
2216         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
2217
2218             # if we have a 100 field and it's values are not correct, skip them.
2219             # if we don't have any valid 100 field, we will create a default one at the end
2220             my $enc = substr( @$values[$i], 26, 2 );
2221             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2222                 $unimarc_and_100_exist = 1;
2223             } else {
2224                 next;
2225             }
2226         }
2227         @$values[$i] =~ s/&/&amp;/g;
2228         @$values[$i] =~ s/</&lt;/g;
2229         @$values[$i] =~ s/>/&gt;/g;
2230         @$values[$i] =~ s/"/&quot;/g;
2231         @$values[$i] =~ s/'/&apos;/g;
2232
2233         #         if ( !utf8::is_utf8( @$values[$i] ) ) {
2234         #             utf8::decode( @$values[$i] );
2235         #         }
2236         if ( ( @$tags[$i] ne $prevtag ) ) {
2237             $j++ unless ( @$tags[$i] eq "" );
2238             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2239             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2240             my $ind1       = _default_ind_to_space($indicator1);
2241             my $ind2;
2242             if ( @$indicator[$j] ) {
2243                 $ind2 = _default_ind_to_space($indicator2);
2244             } else {
2245                 warn "Indicator in @$tags[$i] is empty";
2246                 $ind2 = " ";
2247             }
2248             if ( !$first ) {
2249                 $xml .= "</datafield>\n";
2250                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2251                     && ( @$values[$i] ne "" ) ) {
2252                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2253                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2254                     $first = 0;
2255                 } else {
2256                     $first = 1;
2257                 }
2258             } else {
2259                 if ( @$values[$i] ne "" ) {
2260
2261                     # leader
2262                     if ( @$tags[$i] eq "000" ) {
2263                         $xml .= "<leader>@$values[$i]</leader>\n";
2264                         $first = 1;
2265
2266                         # rest of the fixed fields
2267                     } elsif ( @$tags[$i] < 10 ) {
2268                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2269                         $first = 1;
2270                     } else {
2271                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2272                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2273                         $first = 0;
2274                     }
2275                 }
2276             }
2277         } else {    # @$tags[$i] eq $prevtag
2278             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2279             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2280             my $ind1       = _default_ind_to_space($indicator1);
2281             my $ind2;
2282             if ( @$indicator[$j] ) {
2283                 $ind2 = _default_ind_to_space($indicator2);
2284             } else {
2285                 warn "Indicator in @$tags[$i] is empty";
2286                 $ind2 = " ";
2287             }
2288             if ( @$values[$i] eq "" ) {
2289             } else {
2290                 if ($first) {
2291                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2292                     $first = 0;
2293                 }
2294                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2295             }
2296         }
2297         $prevtag = @$tags[$i];
2298     }
2299     $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2300     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2301
2302         #     warn "SETTING 100 for $auth_type";
2303         my $string = strftime( "%Y%m%d", localtime(time) );
2304
2305         # set 50 to position 26 is biblios, 13 if authorities
2306         my $pos = 26;
2307         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2308         $string = sprintf( "%-*s", 35, $string );
2309         substr( $string, $pos, 6, "50" );
2310         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2311         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2312         $xml .= "</datafield>\n";
2313     }
2314     $xml .= "</record>\n";
2315     $xml .= MARC::File::XML::footer();
2316     return $xml;
2317 }
2318
2319 =head2 _default_ind_to_space
2320
2321 Passed what should be an indicator returns a space
2322 if its undefined or zero length
2323
2324 =cut
2325
2326 sub _default_ind_to_space {
2327     my $s = shift;
2328     if ( !defined $s || $s eq q{} ) {
2329         return ' ';
2330     }
2331     return $s;
2332 }
2333
2334 =head2 TransformHtmlToMarc
2335
2336     L<$record> = TransformHtmlToMarc(L<$cgi>)
2337     L<$cgi> is the CGI object which containts the values for subfields
2338     {
2339         'tag_010_indicator1_531951' ,
2340         'tag_010_indicator2_531951' ,
2341         'tag_010_code_a_531951_145735' ,
2342         'tag_010_subfield_a_531951_145735' ,
2343         'tag_200_indicator1_873510' ,
2344         'tag_200_indicator2_873510' ,
2345         'tag_200_code_a_873510_673465' ,
2346         'tag_200_subfield_a_873510_673465' ,
2347         'tag_200_code_b_873510_704318' ,
2348         'tag_200_subfield_b_873510_704318' ,
2349         'tag_200_code_e_873510_280822' ,
2350         'tag_200_subfield_e_873510_280822' ,
2351         'tag_200_code_f_873510_110730' ,
2352         'tag_200_subfield_f_873510_110730' ,
2353     }
2354     L<$record> is the MARC::Record object.
2355
2356 =cut
2357
2358 sub TransformHtmlToMarc {
2359     my $cgi    = shift;
2360
2361     my @params = $cgi->param();
2362
2363     # explicitly turn on the UTF-8 flag for all
2364     # 'tag_' parameters to avoid incorrect character
2365     # conversion later on
2366     my $cgi_params = $cgi->Vars;
2367     foreach my $param_name ( keys %$cgi_params ) {
2368         if ( $param_name =~ /^tag_/ ) {
2369             my $param_value = $cgi_params->{$param_name};
2370             if ( utf8::decode($param_value) ) {
2371                 $cgi_params->{$param_name} = $param_value;
2372             }
2373
2374             # FIXME - need to do something if string is not valid UTF-8
2375         }
2376     }
2377
2378     # creating a new record
2379     my $record = MARC::Record->new();
2380     my $i      = 0;
2381     my @fields;
2382 #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!
2383     while ( $params[$i] ) {    # browse all CGI params
2384         my $param    = $params[$i];
2385         my $newfield = 0;
2386
2387         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2388         if ( $param eq 'biblionumber' ) {
2389             my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
2390             if ( $biblionumbertagfield < 10 ) {
2391                 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2392             } else {
2393                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2394             }
2395             push @fields, $newfield if ($newfield);
2396         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2397             my $tag = $1;
2398
2399             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2400             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2401             $newfield = 0;
2402             my $j = $i + 2;
2403
2404             if ( $tag < 10 ) {                              # no code for theses fields
2405                                                             # in MARC editor, 000 contains the leader.
2406                 if ( $tag eq '000' ) {
2407                     # Force a fake leader even if not provided to avoid crashing
2408                     # during decoding MARC record containing UTF-8 characters
2409                     $record->leader(
2410                         length( $cgi->param($params[$j+1]) ) == 24
2411                         ? $cgi->param( $params[ $j + 1 ] )
2412                         : '     nam a22        4500'
2413                         )
2414                     ;
2415                     # between 001 and 009 (included)
2416                 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2417                     $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2418                 }
2419
2420                 # > 009, deal with subfields
2421             } else {
2422                 # browse subfields for this tag (reason for _code_ match)
2423                 while(defined $params[$j] && $params[$j] =~ /_code_/) {
2424                     last unless defined $params[$j+1];
2425                     #if next param ne subfield, then it was probably empty
2426                     #try next param by incrementing j
2427                     if($params[$j+1]!~/_subfield_/) {$j++; next; }
2428                     my $fval= $cgi->param($params[$j+1]);
2429                     #check if subfield value not empty and field exists
2430                     if($fval ne '' && $newfield) {
2431                         $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
2432                     }
2433                     elsif($fval ne '') {
2434                         $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
2435                     }
2436                     $j += 2;
2437                 } #end-of-while
2438                 $i= $j-1; #update i for outer loop accordingly
2439             }
2440             push @fields, $newfield if ($newfield);
2441         }
2442         $i++;
2443     }
2444
2445     $record->append_fields(@fields);
2446     return $record;
2447 }
2448
2449 # cache inverted MARC field map
2450 our $inverted_field_map;
2451
2452 =head2 TransformMarcToKoha
2453
2454   $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2455
2456 Extract data from a MARC bib record into a hashref representing
2457 Koha biblio, biblioitems, and items fields.
2458
2459 =cut
2460
2461 sub TransformMarcToKoha {
2462     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2463
2464     my $result;
2465     $limit_table = $limit_table || 0;
2466     $frameworkcode = '' unless defined $frameworkcode;
2467
2468     unless ( defined $inverted_field_map ) {
2469         $inverted_field_map = _get_inverted_marc_field_map();
2470     }
2471
2472     my %tables = ();
2473     if ( defined $limit_table && $limit_table eq 'items' ) {
2474         $tables{'items'} = 1;
2475     } else {
2476         $tables{'items'}       = 1;
2477         $tables{'biblio'}      = 1;
2478         $tables{'biblioitems'} = 1;
2479     }
2480
2481     # traverse through record
2482   MARCFIELD: foreach my $field ( $record->fields() ) {
2483         my $tag = $field->tag();
2484         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2485         if ( $field->is_control_field() ) {
2486             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2487           ENTRY: foreach my $entry ( @{$kohafields} ) {
2488                 my ( $subfield, $table, $column ) = @{$entry};
2489                 next ENTRY unless exists $tables{$table};
2490                 my $key = _disambiguate( $table, $column );
2491                 if ( $result->{$key} ) {
2492                     unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2493                         $result->{$key} .= " | " . $field->data();
2494                     }
2495                 } else {
2496                     $result->{$key} = $field->data();
2497                 }
2498             }
2499         } else {
2500
2501             # deal with subfields
2502           MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2503                 my $code = $sf->[0];
2504                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2505                 my $value = $sf->[1];
2506               SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2507                     my ( $table, $column ) = @{$entry};
2508                     next SFENTRY unless exists $tables{$table};
2509                     my $key = _disambiguate( $table, $column );
2510                     if ( $result->{$key} ) {
2511                         unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2512                             $result->{$key} .= " | " . $value;
2513                         }
2514                     } else {
2515                         $result->{$key} = $value;
2516                     }
2517                 }
2518             }
2519         }
2520     }
2521
2522     # modify copyrightdate to keep only the 1st year found
2523     if ( exists $result->{'copyrightdate'} ) {
2524         my $temp = $result->{'copyrightdate'};
2525         $temp =~ m/c(\d\d\d\d)/;
2526         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2527             $result->{'copyrightdate'} = $1;
2528         } else {                                       # if no cYYYY, get the 1st date.
2529             $temp =~ m/(\d\d\d\d)/;
2530             $result->{'copyrightdate'} = $1;
2531         }
2532     }
2533
2534     # modify publicationyear to keep only the 1st year found
2535     if ( exists $result->{'publicationyear'} ) {
2536         my $temp = $result->{'publicationyear'};
2537         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2538             $result->{'publicationyear'} = $1;
2539         } else {                                       # if no cYYYY, get the 1st date.
2540             $temp =~ m/(\d\d\d\d)/;
2541             $result->{'publicationyear'} = $1;
2542         }
2543     }
2544
2545     return $result;
2546 }
2547
2548 sub _get_inverted_marc_field_map {
2549     my $field_map = {};
2550     my $relations = C4::Context->marcfromkohafield;
2551
2552     foreach my $frameworkcode ( keys %{$relations} ) {
2553         foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2554             next unless @{ $relations->{$frameworkcode}->{$kohafield} };    # not all columns are mapped to MARC tag & subfield
2555             my $tag      = $relations->{$frameworkcode}->{$kohafield}->[0];
2556             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2557             my ( $table, $column ) = split /[.]/, $kohafield, 2;
2558             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2559             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2560         }
2561     }
2562     return $field_map;
2563 }
2564
2565 =head2 _disambiguate
2566
2567   $newkey = _disambiguate($table, $field);
2568
2569 This is a temporary hack to distinguish between the
2570 following sets of columns when using TransformMarcToKoha.
2571
2572   items.cn_source & biblioitems.cn_source
2573   items.cn_sort & biblioitems.cn_sort
2574
2575 Columns that are currently NOT distinguished (FIXME
2576 due to lack of time to fully test) are:
2577
2578   biblio.notes and biblioitems.notes
2579   biblionumber
2580   timestamp
2581   biblioitemnumber
2582
2583 FIXME - this is necessary because prefixing each column
2584 name with the table name would require changing lots
2585 of code and templates, and exposing more of the DB
2586 structure than is good to the UI templates, particularly
2587 since biblio and bibloitems may well merge in a future
2588 version.  In the future, it would also be good to
2589 separate DB access and UI presentation field names
2590 more.
2591
2592 =cut
2593
2594 sub CountItemsIssued {
2595     my ($biblionumber) = @_;
2596     my $dbh            = C4::Context->dbh;
2597     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2598     $sth->execute($biblionumber);
2599     my $row = $sth->fetchrow_hashref();
2600     return $row->{'issuedCount'};
2601 }
2602
2603 sub _disambiguate {
2604     my ( $table, $column ) = @_;
2605     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2606         return $table . '.' . $column;
2607     } else {
2608         return $column;
2609     }
2610
2611 }
2612
2613 =head2 get_koha_field_from_marc
2614
2615   $result->{_disambiguate($table, $field)} =
2616      get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2617
2618 Internal function to map data from the MARC record to a specific non-MARC field.
2619 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2620
2621 =cut
2622
2623 sub get_koha_field_from_marc {
2624     my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2625     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2626     my $kohafield;
2627     foreach my $field ( $record->field($tagfield) ) {
2628         if ( $field->tag() < 10 ) {
2629             if ($kohafield) {
2630                 $kohafield .= " | " . $field->data();
2631             } else {
2632                 $kohafield = $field->data();
2633             }
2634         } else {
2635             if ( $field->subfields ) {
2636                 my @subfields = $field->subfields();
2637                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2638                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2639                         if ($kohafield) {
2640                             $kohafield .= " | " . $subfields[$subfieldcount][1];
2641                         } else {
2642                             $kohafield = $subfields[$subfieldcount][1];
2643                         }
2644                     }
2645                 }
2646             }
2647         }
2648     }
2649     return $kohafield;
2650 }
2651
2652 =head2 TransformMarcToKohaOneField
2653
2654   $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2655
2656 =cut
2657
2658 sub TransformMarcToKohaOneField {
2659
2660     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2661     # only the 1st will be retrieved...
2662     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2663     my $res = "";
2664     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2665     foreach my $field ( $record->field($tagfield) ) {
2666         if ( $field->tag() < 10 ) {
2667             if ( $result->{$kohafield} ) {
2668                 $result->{$kohafield} .= " | " . $field->data();
2669             } else {
2670                 $result->{$kohafield} = $field->data();
2671             }
2672         } else {
2673             if ( $field->subfields ) {
2674                 my @subfields = $field->subfields();
2675                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2676                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2677                         if ( $result->{$kohafield} ) {
2678                             $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2679                         } else {
2680                             $result->{$kohafield} = $subfields[$subfieldcount][1];
2681                         }
2682                     }
2683                 }
2684             }
2685         }
2686     }
2687     return $result;
2688 }
2689
2690
2691 #"
2692
2693 #
2694 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2695 # at the same time
2696 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2697 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2698 # =head2 ModZebrafiles
2699 #
2700 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2701 #
2702 # =cut
2703 #
2704 # sub ModZebrafiles {
2705 #
2706 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2707 #
2708 #     my $op;
2709 #     my $zebradir =
2710 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2711 #     unless ( opendir( DIR, "$zebradir" ) ) {
2712 #         warn "$zebradir not found";
2713 #         return;
2714 #     }
2715 #     closedir DIR;
2716 #     my $filename = $zebradir . $biblionumber;
2717 #
2718 #     if ($record) {
2719 #         open( OUTPUT, ">", $filename . ".xml" );
2720 #         print OUTPUT $record;
2721 #         close OUTPUT;
2722 #     }
2723 # }
2724
2725 =head2 ModZebra
2726
2727   ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2728
2729 $biblionumber is the biblionumber we want to index
2730
2731 $op is specialUpdate or delete, and is used to know what we want to do
2732
2733 $server is the server that we want to update
2734
2735 $oldRecord is the MARC::Record containing the previous version of the record.  This is used only when
2736 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2737 do an update.
2738
2739 $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.
2740
2741 =cut
2742
2743 sub ModZebra {
2744 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2745     my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2746     my $dbh = C4::Context->dbh;
2747
2748     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2749     # at the same time
2750     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2751     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2752
2753     if ( C4::Context->preference("NoZebra") ) {
2754
2755         # lock the nozebra table : we will read index lines, update them in Perl process
2756         # and write everything in 1 transaction.
2757         # lock the table to avoid someone else overwriting what we are doing
2758         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2759         my %result;    # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2760         if ( $op eq 'specialUpdate' ) {
2761
2762             # OK, we have to add or update the record
2763             # 1st delete (virtually, in indexes), if record actually exists
2764             if ($oldRecord) {
2765                 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2766             }
2767
2768             # ... add the record
2769             %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2770         } else {
2771
2772             # it's a deletion, delete the record...
2773             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2774             %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2775         }
2776
2777         # ok, now update the database...
2778         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2779         foreach my $key ( keys %result ) {
2780             foreach my $index ( keys %{ $result{$key} } ) {
2781                 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2782             }
2783         }
2784         $dbh->do('UNLOCK TABLES');
2785     } else {
2786
2787         #
2788         # we use zebra, just fill zebraqueue table
2789         #
2790         my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2791                          WHERE server = ?
2792                          AND   biblio_auth_number = ?
2793                          AND   operation = ?
2794                          AND   done = 0";
2795         my $check_sth = $dbh->prepare_cached($check_sql);
2796         $check_sth->execute( $server, $biblionumber, $op );
2797         my ($count) = $check_sth->fetchrow_array;
2798         $check_sth->finish();
2799         if ( $count == 0 ) {
2800             my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2801             $sth->execute( $biblionumber, $server, $op );
2802             $sth->finish;
2803         }
2804     }
2805 }
2806
2807 =head2 GetNoZebraIndexes
2808
2809   %indexes = GetNoZebraIndexes;
2810
2811 return the data from NoZebraIndexes syspref.
2812
2813 =cut
2814
2815 sub GetNoZebraIndexes {
2816     my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2817     my %indexes;
2818   INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2819         $line =~ /(.*)=>(.*)/;
2820         my $index  = $1;    # initial ' or " is removed afterwards
2821         my $fields = $2;
2822         $index  =~ s/'|"|\s//g;
2823         $fields =~ s/'|"|\s//g;
2824         $indexes{$index} = $fields;
2825     }
2826     return %indexes;
2827 }
2828
2829 =head2 EmbedItemsInMarcBiblio
2830
2831     EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers);
2832
2833 Given a MARC::Record object containing a bib record,
2834 modify it to include the items attached to it as 9XX
2835 per the bib's MARC framework.
2836 if $itemnumbers is defined, only specified itemnumbers are embedded
2837
2838 =cut
2839
2840 sub EmbedItemsInMarcBiblio {
2841     my ($marc, $biblionumber, $itemnumbers) = @_;
2842     croak "No MARC record" unless $marc;
2843
2844     my $frameworkcode = GetFrameworkCode($biblionumber);
2845     _strip_item_fields($marc, $frameworkcode);
2846
2847     # ... and embed the current items
2848     my $dbh = C4::Context->dbh;
2849     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2850     $sth->execute($biblionumber);
2851     my @item_fields;
2852     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2853     while (my ($itemnumber) = $sth->fetchrow_array) {
2854         next if $itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
2855         require C4::Items;
2856         my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
2857         push @item_fields, $item_marc->field($itemtag);
2858     }
2859     $marc->append_fields(@item_fields);
2860 }
2861
2862 =head1 INTERNAL FUNCTIONS
2863
2864 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2865
2866 function to delete a biblio in NoZebra indexes
2867 This function does NOT delete anything in database : it reads all the indexes entries
2868 that have to be deleted & delete them in the hash
2869
2870 The SQL part is done either :
2871  - after the Add if we are modifying a biblio (delete + add again)
2872  - immediatly after this sub if we are doing a true deletion.
2873
2874 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2875
2876 =cut
2877
2878 sub _DelBiblioNoZebra {
2879     my ( $biblionumber, $record, $server ) = @_;
2880
2881     # Get the indexes
2882     my $dbh = C4::Context->dbh;
2883
2884     # Get the indexes
2885     my %index;
2886     my $title;
2887     if ( $server eq 'biblioserver' ) {
2888         %index = GetNoZebraIndexes;
2889
2890         # get title of the record (to store the 10 first letters with the index)
2891         my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' );    # FIXME: should be GetFrameworkCode($biblionumber) ??
2892         $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2893     } else {
2894
2895         # for authorities, the "title" is the $a mainentry
2896         my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2897         my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2898         warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2899         $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2900         $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2901         $index{'mainentry'}     = $authref->{'auth_tag_to_report'} . '*';
2902         $index{'auth_type'}     = "${auth_type_tag}${auth_type_sf}";
2903     }
2904
2905     my %result;
2906
2907     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2908     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2909
2910     # limit to 10 char, should be enough, and limit the DB size
2911     $title = substr( $title, 0, 10 );
2912
2913     #parse each field
2914     my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2915     foreach my $field ( $record->fields() ) {
2916
2917         #parse each subfield
2918         next if $field->tag < 10;
2919         foreach my $subfield ( $field->subfields() ) {
2920             my $tag          = $field->tag();
2921             my $subfieldcode = $subfield->[0];
2922             my $indexed      = 0;
2923
2924             # check each index to see if the subfield is stored somewhere
2925             # otherwise, store it in __RAW__ index
2926             foreach my $key ( keys %index ) {
2927
2928                 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2929                 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2930                     $indexed = 1;
2931                     my $line = lc $subfield->[1];
2932
2933                     # remove meaningless value in the field...
2934                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2935
2936                     # ... and split in words
2937                     foreach ( split / /, $line ) {
2938                         next unless $_;    # skip  empty values (multiple spaces)
2939                                            # if the entry is already here, do nothing, the biblionumber has already be removed
2940                         unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2941
2942                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2943                             $sth2->execute( $server, $key, $_ );
2944                             my $existing_biblionumbers = $sth2->fetchrow;
2945
2946                             # it exists
2947                             if ($existing_biblionumbers) {
2948
2949                                 #                                 warn " existing for $key $_: $existing_biblionumbers";
2950                                 $result{$key}->{$_} = $existing_biblionumbers;
2951                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2952                             }
2953                         }
2954                     }
2955                 }
2956             }
2957
2958             # the subfield is not indexed, store it in __RAW__ index anyway
2959             unless ($indexed) {
2960                 my $line = lc $subfield->[1];
2961                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2962
2963                 # ... and split in words
2964                 foreach ( split / /, $line ) {
2965                     next unless $_;    # skip  empty values (multiple spaces)
2966                                        # if the entry is already here, do nothing, the biblionumber has already be removed
2967                     unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
2968
2969                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2970                         $sth2->execute( $server, '__RAW__', $_ );
2971                         my $existing_biblionumbers = $sth2->fetchrow;
2972
2973                         # it exists
2974                         if ($existing_biblionumbers) {
2975                             $result{'__RAW__'}->{$_} = $existing_biblionumbers;
2976                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2977                         }
2978                     }
2979                 }
2980             }
2981         }
2982     }
2983     return %result;
2984 }
2985
2986 =head2 _AddBiblioNoZebra
2987
2988   _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2989
2990 function to add a biblio in NoZebra indexes
2991
2992 =cut
2993
2994 sub _AddBiblioNoZebra {
2995     my ( $biblionumber, $record, $server, %result ) = @_;
2996     my $dbh = C4::Context->dbh;
2997
2998     # Get the indexes
2999     my %index;
3000     my $title;
3001     if ( $server eq 'biblioserver' ) {
3002         %index = GetNoZebraIndexes;
3003
3004         # get title of the record (to store the 10 first letters with the index)
3005         my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' );    # FIXME: should be GetFrameworkCode($biblionumber) ??
3006         $title = lc( $record->subfield( $titletag, $titlesubfield ) );
3007     } else {
3008
3009         # warn "server : $server";
3010         # for authorities, the "title" is the $a mainentry
3011         my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
3012         my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
3013         warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
3014         $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
3015         $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
3016         $index{'mainentry'}     = $authref->{auth_tag_to_report} . '*';
3017         $index{'auth_type'}     = "${auth_type_tag}${auth_type_sf}";
3018     }
3019
3020     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3021     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
3022
3023     # limit to 10 char, should be enough, and limit the DB size
3024     $title = substr( $title, 0, 10 );
3025
3026     #parse each field
3027     my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3028     foreach my $field ( $record->fields() ) {
3029
3030         #parse each subfield
3031         ###FIXME: impossible to index a 001-009 value with NoZebra
3032         next if $field->tag < 10;
3033         foreach my $subfield ( $field->subfields() ) {
3034             my $tag          = $field->tag();
3035             my $subfieldcode = $subfield->[0];
3036             my $indexed      = 0;
3037
3038             #             warn "INDEXING :".$subfield->[1];
3039             # check each index to see if the subfield is stored somewhere
3040             # otherwise, store it in __RAW__ index
3041             foreach my $key ( keys %index ) {
3042
3043                 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3044                 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
3045                     $indexed = 1;
3046                     my $line = lc $subfield->[1];
3047
3048                     # remove meaningless value in the field...
3049                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
3050
3051                     # ... and split in words
3052                     foreach ( split / /, $line ) {
3053                         next unless $_;    # skip  empty values (multiple spaces)
3054                                            # if the entry is already here, improve weight
3055
3056                         #                         warn "managing $_";
3057                         if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
3058                             my $weight = $1 + 1;
3059                             $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
3060                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3061                         } else {
3062
3063                             # get the value if it exist in the nozebra table, otherwise, create it
3064                             $sth2->execute( $server, $key, $_ );
3065                             my $existing_biblionumbers = $sth2->fetchrow;
3066
3067                             # it exists
3068                             if ($existing_biblionumbers) {
3069                                 $result{$key}->{"$_"} = $existing_biblionumbers;
3070                                 my $weight = defined $1 ? $1 + 1 : 1;
3071                                 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
3072                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3073
3074                                 # create a new ligne for this entry
3075                             } else {
3076
3077                                 #                             warn "INSERT : $server / $key / $_";
3078                                 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
3079                                 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
3080                             }
3081                         }
3082                     }
3083                 }
3084             }
3085
3086             # the subfield is not indexed, store it in __RAW__ index anyway
3087             unless ($indexed) {
3088                 my $line = lc $subfield->[1];
3089                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
3090
3091                 # ... and split in words
3092                 foreach ( split / /, $line ) {
3093                     next unless $_;    # skip  empty values (multiple spaces)
3094                                        # if the entry is already here, improve weight
3095                     my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
3096                     if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
3097                         my $weight = $1 + 1;
3098                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3099                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3100                     } else {
3101
3102                         # get the value if it exist in the nozebra table, otherwise, create it
3103                         $sth2->execute( $server, '__RAW__', $_ );
3104                         my $existing_biblionumbers = $sth2->fetchrow;
3105
3106                         # it exists
3107                         if ($existing_biblionumbers) {
3108                             $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
3109                             my $weight = ( $1 ? $1 : 0 ) + 1;
3110                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3111                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3112
3113                             # create a new ligne for this entry
3114                         } else {
3115                             $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ',  indexname="__RAW__",value=' . $dbh->quote($_) );
3116                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
3117                         }
3118                     }
3119                 }
3120             }
3121         }
3122     }
3123     return %result;
3124 }
3125
3126 =head2 _koha_marc_update_bib_ids
3127
3128
3129   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3130
3131 Internal function to add or update biblionumber and biblioitemnumber to
3132 the MARC XML.
3133
3134 =cut
3135
3136 sub _koha_marc_update_bib_ids {
3137     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3138
3139     # we must add bibnum and bibitemnum in MARC::Record...
3140     # we build the new field with biblionumber and biblioitemnumber
3141     # we drop the original field
3142     # we add the new builded field.
3143     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
3144     die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
3145     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3146     die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblioitem_tag;
3147
3148     if ( $biblio_tag == $biblioitem_tag ) {
3149
3150         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3151         my $new_field = MARC::Field->new(
3152             $biblio_tag, '', '',
3153             "$biblio_subfield"     => $biblionumber,
3154             "$biblioitem_subfield" => $biblioitemnumber
3155         );
3156
3157         # drop old field and create new one...
3158         my $old_field = $record->field($biblio_tag);
3159         $record->delete_field($old_field) if $old_field;
3160         $record->insert_fields_ordered($new_field);
3161     } else {
3162
3163         # biblionumber & biblioitemnumber are in different fields
3164
3165         # deal with biblionumber
3166         my ( $new_field, $old_field );
3167         if ( $biblio_tag < 10 ) {
3168             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3169         } else {
3170             $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3171         }
3172
3173         # drop old field and create new one...
3174         $old_field = $record->field($biblio_tag);
3175         $record->delete_field($old_field) if $old_field;
3176         $record->insert_fields_ordered($new_field);
3177
3178         # deal with biblioitemnumber
3179         if ( $biblioitem_tag < 10 ) {
3180             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3181         } else {
3182             $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3183         }
3184
3185         # drop old field and create new one...
3186         $old_field = $record->field($biblioitem_tag);
3187         $record->delete_field($old_field) if $old_field;
3188         $record->insert_fields_ordered($new_field);
3189     }
3190 }
3191
3192 =head2 _koha_marc_update_biblioitem_cn_sort
3193
3194   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3195
3196 Given a MARC bib record and the biblioitem hash, update the
3197 subfield that contains a copy of the value of biblioitems.cn_sort.
3198
3199 =cut
3200
3201 sub _koha_marc_update_biblioitem_cn_sort {
3202     my $marc          = shift;
3203     my $biblioitem    = shift;
3204     my $frameworkcode = shift;
3205
3206     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3207     return unless $biblioitem_tag;
3208
3209     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3210
3211     if ( my $field = $marc->field($biblioitem_tag) ) {
3212         $field->delete_subfield( code => $biblioitem_subfield );
3213         if ( $cn_sort ne '' ) {
3214             $field->add_subfields( $biblioitem_subfield => $cn_sort );
3215         }
3216     } else {
3217
3218         # if we get here, no biblioitem tag is present in the MARC record, so
3219         # we'll create it if $cn_sort is not empty -- this would be
3220         # an odd combination of events, however
3221         if ($cn_sort) {
3222             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3223         }
3224     }
3225 }
3226
3227 =head2 _koha_add_biblio
3228
3229   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3230
3231 Internal function to add a biblio ($biblio is a hash with the values)
3232
3233 =cut
3234
3235 sub _koha_add_biblio {
3236     my ( $dbh, $biblio, $frameworkcode ) = @_;
3237
3238     my $error;
3239
3240     # set the series flag
3241     unless (defined $biblio->{'serial'}){
3242         $biblio->{'serial'} = 0;
3243         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3244     }
3245
3246     my $query = "INSERT INTO biblio
3247         SET frameworkcode = ?,
3248             author = ?,
3249             title = ?,
3250             unititle =?,
3251             notes = ?,
3252             serial = ?,
3253             seriestitle = ?,
3254             copyrightdate = ?,
3255             datecreated=NOW(),
3256             abstract = ?
3257         ";
3258     my $sth = $dbh->prepare($query);
3259     $sth->execute(
3260         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3261         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3262     );
3263
3264     my $biblionumber = $dbh->{'mysql_insertid'};
3265     if ( $dbh->errstr ) {
3266         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3267         warn $error;
3268     }
3269
3270     $sth->finish();
3271
3272     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3273     return ( $biblionumber, $error );
3274 }
3275
3276 =head2 _koha_modify_biblio
3277
3278   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3279
3280 Internal function for updating the biblio table
3281
3282 =cut
3283
3284 sub _koha_modify_biblio {
3285     my ( $dbh, $biblio, $frameworkcode ) = @_;
3286     my $error;
3287
3288     my $query = "
3289         UPDATE biblio
3290         SET    frameworkcode = ?,
3291                author = ?,
3292                title = ?,
3293                unititle = ?,
3294                notes = ?,
3295                serial = ?,
3296                seriestitle = ?,
3297                copyrightdate = ?,
3298                abstract = ?
3299         WHERE  biblionumber = ?
3300         "
3301       ;
3302     my $sth = $dbh->prepare($query);
3303
3304     $sth->execute(
3305         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3306         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3307     ) if $biblio->{'biblionumber'};
3308
3309     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3310         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3311         warn $error;
3312     }
3313     return ( $biblio->{'biblionumber'}, $error );
3314 }
3315
3316 =head2 _koha_modify_biblioitem_nonmarc
3317
3318   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3319
3320 Updates biblioitems row except for marc and marcxml, which should be changed
3321 via ModBiblioMarc
3322
3323 =cut
3324
3325 sub _koha_modify_biblioitem_nonmarc {
3326     my ( $dbh, $biblioitem ) = @_;
3327     my $error;
3328
3329     # re-calculate the cn_sort, it may have changed
3330     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3331
3332     my $query = "UPDATE biblioitems
3333     SET biblionumber    = ?,
3334         volume          = ?,
3335         number          = ?,
3336         itemtype        = ?,
3337         isbn            = ?,
3338         issn            = ?,
3339         publicationyear = ?,
3340         publishercode   = ?,
3341         volumedate      = ?,
3342         volumedesc      = ?,
3343         collectiontitle = ?,
3344         collectionissn  = ?,
3345         collectionvolume= ?,
3346         editionstatement= ?,
3347         editionresponsibility = ?,
3348         illus           = ?,
3349         pages           = ?,
3350         notes           = ?,
3351         size            = ?,
3352         place           = ?,
3353         lccn            = ?,
3354         url             = ?,
3355         cn_source       = ?,
3356         cn_class        = ?,
3357         cn_item         = ?,
3358         cn_suffix       = ?,
3359         cn_sort         = ?,
3360         totalissues     = ?,
3361         ean             = ?,
3362         agerestriction  = ?
3363         where biblioitemnumber = ?
3364         ";
3365     my $sth = $dbh->prepare($query);
3366     $sth->execute(
3367         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3368         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3369         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3370         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3371         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3372         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3373         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3374         $biblioitem->{'ean'},              $biblioitem->{'agerestriction'},   $biblioitem->{'biblioitemnumber'}
3375     );
3376     if ( $dbh->errstr ) {
3377         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3378         warn $error;
3379     }
3380     return ( $biblioitem->{'biblioitemnumber'}, $error );
3381 }
3382
3383 =head2 _koha_add_biblioitem
3384
3385   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3386
3387 Internal function to add a biblioitem
3388
3389 =cut
3390
3391 sub _koha_add_biblioitem {
3392     my ( $dbh, $biblioitem ) = @_;
3393     my $error;
3394
3395     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3396     my $query = "INSERT INTO biblioitems SET
3397         biblionumber    = ?,
3398         volume          = ?,
3399         number          = ?,
3400         itemtype        = ?,
3401         isbn            = ?,
3402         issn            = ?,
3403         publicationyear = ?,
3404         publishercode   = ?,
3405         volumedate      = ?,
3406         volumedesc      = ?,
3407         collectiontitle = ?,
3408         collectionissn  = ?,
3409         collectionvolume= ?,
3410         editionstatement= ?,
3411         editionresponsibility = ?,
3412         illus           = ?,
3413         pages           = ?,
3414         notes           = ?,
3415         size            = ?,
3416         place           = ?,
3417         lccn            = ?,
3418         marc            = ?,
3419         url             = ?,
3420         cn_source       = ?,
3421         cn_class        = ?,
3422         cn_item         = ?,
3423         cn_suffix       = ?,
3424         cn_sort         = ?,
3425         totalissues     = ?,
3426         ean             = ?,
3427         agerestriction  = ?
3428         ";
3429     my $sth = $dbh->prepare($query);
3430     $sth->execute(
3431         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3432         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3433         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3434         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3435         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3436         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3437         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3438         $biblioitem->{'totalissues'},      $biblioitem->{'ean'},              $biblioitem->{'agerestriction'}
3439     );
3440     my $bibitemnum = $dbh->{'mysql_insertid'};
3441
3442     if ( $dbh->errstr ) {
3443         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3444         warn $error;
3445     }
3446     $sth->finish();
3447     return ( $bibitemnum, $error );
3448 }
3449
3450 =head2 _koha_delete_biblio
3451
3452   $error = _koha_delete_biblio($dbh,$biblionumber);
3453
3454 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3455
3456 C<$dbh> - the database handle
3457
3458 C<$biblionumber> - the biblionumber of the biblio to be deleted
3459
3460 =cut
3461
3462 # FIXME: add error handling
3463
3464 sub _koha_delete_biblio {
3465     my ( $dbh, $biblionumber ) = @_;
3466
3467     # get all the data for this biblio
3468     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3469     $sth->execute($biblionumber);
3470
3471     if ( my $data = $sth->fetchrow_hashref ) {
3472
3473         # save the record in deletedbiblio
3474         # find the fields to save
3475         my $query = "INSERT INTO deletedbiblio SET ";
3476         my @bind  = ();
3477         foreach my $temp ( keys %$data ) {
3478             $query .= "$temp = ?,";
3479             push( @bind, $data->{$temp} );
3480         }
3481
3482         # replace the last , by ",?)"
3483         $query =~ s/\,$//;
3484         my $bkup_sth = $dbh->prepare($query);
3485         $bkup_sth->execute(@bind);
3486         $bkup_sth->finish;
3487
3488         # delete the biblio
3489         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3490         $sth2->execute($biblionumber);
3491         # update the timestamp (Bugzilla 7146)
3492         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3493         $sth2->execute($biblionumber);
3494         $sth2->finish;
3495     }
3496     $sth->finish;
3497     return;
3498 }
3499
3500 =head2 _koha_delete_biblioitems
3501
3502   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3503
3504 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3505
3506 C<$dbh> - the database handle
3507 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3508
3509 =cut
3510
3511 # FIXME: add error handling
3512
3513 sub _koha_delete_biblioitems {
3514     my ( $dbh, $biblioitemnumber ) = @_;
3515
3516     # get all the data for this biblioitem
3517     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3518     $sth->execute($biblioitemnumber);
3519
3520     if ( my $data = $sth->fetchrow_hashref ) {
3521
3522         # save the record in deletedbiblioitems
3523         # find the fields to save
3524         my $query = "INSERT INTO deletedbiblioitems SET ";
3525         my @bind  = ();
3526         foreach my $temp ( keys %$data ) {
3527             $query .= "$temp = ?,";
3528             push( @bind, $data->{$temp} );
3529         }
3530
3531         # replace the last , by ",?)"
3532         $query =~ s/\,$//;
3533         my $bkup_sth = $dbh->prepare($query);
3534         $bkup_sth->execute(@bind);
3535         $bkup_sth->finish;
3536
3537         # delete the biblioitem
3538         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3539         $sth2->execute($biblioitemnumber);
3540         # update the timestamp (Bugzilla 7146)
3541         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3542         $sth2->execute($biblioitemnumber);
3543         $sth2->finish;
3544     }
3545     $sth->finish;
3546     return;
3547 }
3548
3549 =head1 UNEXPORTED FUNCTIONS
3550
3551 =head2 ModBiblioMarc
3552
3553   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3554
3555 Add MARC data for a biblio to koha
3556
3557 Function exported, but should NOT be used, unless you really know what you're doing
3558
3559 =cut
3560
3561 sub ModBiblioMarc {
3562     # pass the MARC::Record to this function, and it will create the records in
3563     # the marc field
3564     my ( $record, $biblionumber, $frameworkcode ) = @_;
3565
3566     # Clone record as it gets modified
3567     $record = $record->clone();
3568     my $dbh    = C4::Context->dbh;
3569     my @fields = $record->fields();
3570     if ( !$frameworkcode ) {
3571         $frameworkcode = "";
3572     }
3573     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3574     $sth->execute( $frameworkcode, $biblionumber );
3575     $sth->finish;
3576     my $encoding = C4::Context->preference("marcflavour");
3577
3578     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3579     if ( $encoding eq "UNIMARC" ) {
3580         my $string = $record->subfield( 100, "a" );
3581         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3582             my $f100 = $record->field(100);
3583             $record->delete_field($f100);
3584         } else {
3585             $string = POSIX::strftime( "%Y%m%d", localtime );
3586             $string =~ s/\-//g;
3587             $string = sprintf( "%-*s", 35, $string );
3588         }
3589         substr( $string, 22, 6, "frey50" );
3590         unless ( $record->subfield( 100, "a" ) ) {
3591             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3592         }
3593     }
3594
3595     #enhancement 5374: update transaction date (005) for marc21/unimarc
3596     if($encoding =~ /MARC21|UNIMARC/) {
3597       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3598         # YY MM DD HH MM SS (update year and month)
3599       my $f005= $record->field('005');
3600       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3601     }
3602
3603     my $oldRecord;
3604     if ( C4::Context->preference("NoZebra") ) {
3605
3606         # only NoZebra indexing needs to have
3607         # the previous version of the record
3608         $oldRecord = GetMarcBiblio($biblionumber);
3609     }
3610     $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3611     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3612     $sth->finish;
3613     ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3614     return $biblionumber;
3615 }
3616
3617 =head2 get_biblio_authorised_values
3618
3619 find the types and values for all authorised values assigned to this biblio.
3620
3621 parameters:
3622     biblionumber
3623     MARC::Record of the bib
3624
3625 returns: a hashref mapping the authorised value to the value set for this biblionumber
3626
3627   $authorised_values = {
3628                        'Scent'     => 'flowery',
3629                        'Audience'  => 'Young Adult',
3630                        'itemtypes' => 'SER',
3631                         };
3632
3633 Notes: forlibrarian should probably be passed in, and called something different.
3634
3635 =cut
3636
3637 sub get_biblio_authorised_values {
3638     my $biblionumber = shift;
3639     my $record       = shift;
3640
3641     my $forlibrarian  = 1;                                 # are we in staff or opac?
3642     my $frameworkcode = GetFrameworkCode($biblionumber);
3643
3644     my $authorised_values;
3645
3646     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3647       or return $authorised_values;
3648
3649     # assume that these entries in the authorised_value table are bibliolevel.
3650     # ones that start with 'item%' are item level.
3651     my $query = q(SELECT distinct authorised_value, kohafield
3652                     FROM marc_subfield_structure
3653                     WHERE authorised_value !=''
3654                       AND (kohafield like 'biblio%'
3655                        OR  kohafield like '') );
3656     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3657
3658     foreach my $tag ( keys(%$tagslib) ) {
3659         foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3660
3661             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3662             if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3663                 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3664                     if ( defined $record->field($tag) ) {
3665                         my $this_subfield_value = $record->field($tag)->subfield($subfield);
3666                         if ( defined $this_subfield_value ) {
3667                             $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3668                         }
3669                     }
3670                 }
3671             }
3672         }
3673     }
3674
3675     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3676     return $authorised_values;
3677 }
3678
3679 =head2 CountBiblioInOrders
3680
3681 =over 4
3682 $count = &CountBiblioInOrders( $biblionumber);
3683
3684 =back
3685
3686 This function return count of biblios in orders with $biblionumber
3687
3688 =cut
3689
3690 sub CountBiblioInOrders {
3691  my ($biblionumber) = @_;
3692     my $dbh            = C4::Context->dbh;
3693     my $query          = "SELECT count(*)
3694           FROM  aqorders
3695           WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3696     my $sth = $dbh->prepare($query);
3697     $sth->execute($biblionumber);
3698     my $count = $sth->fetchrow;
3699     return ($count);
3700 }
3701
3702 =head2 GetSubscriptionsId
3703
3704 =over 4
3705 $subscriptions = &GetSubscriptionsId($biblionumber);
3706
3707 =back
3708
3709 This function return an array of subscriptionid with $biblionumber
3710
3711 =cut
3712
3713 sub GetSubscriptionsId {
3714  my ($biblionumber) = @_;
3715     my $dbh            = C4::Context->dbh;
3716     my $query          = "SELECT subscriptionid
3717           FROM  subscription
3718           WHERE biblionumber=?";
3719     my $sth = $dbh->prepare($query);
3720     $sth->execute($biblionumber);
3721     my @subscriptions = $sth->fetchrow_array;
3722     return (@subscriptions);
3723 }
3724
3725 =head2 GetHolds
3726
3727 =over 4
3728 $holds = &GetHolds($biblionumber);
3729
3730 =back
3731
3732 This function return the count of holds with $biblionumber
3733
3734 =cut
3735
3736 sub GetHolds {
3737  my ($biblionumber) = @_;
3738     my $dbh            = C4::Context->dbh;
3739     my $query          = "SELECT count(*)
3740           FROM  reserves
3741           WHERE biblionumber=?";
3742     my $sth = $dbh->prepare($query);
3743     $sth->execute($biblionumber);
3744     my $holds = $sth->fetchrow;
3745     return ($holds);
3746 }
3747
3748 =head2 prepare_host_field
3749
3750 $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
3751 Generate the host item entry for an analytic child entry
3752
3753 =cut
3754
3755 sub prepare_host_field {
3756     my ( $hostbiblio, $marcflavour ) = @_;
3757     $marcflavour ||= C4::Context->preference('marcflavour');
3758     my $host = GetMarcBiblio($hostbiblio);
3759     # unfortunately as_string does not 'do the right thing'
3760     # if field returns undef
3761     my %sfd;
3762     my $field;
3763     my $host_field;
3764     if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
3765         if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
3766             my $s = $field->as_string('ab');
3767             if ($s) {
3768                 $sfd{a} = $s;
3769             }
3770         }
3771         if ( $field = $host->field('245') ) {
3772             my $s = $field->as_string('a');
3773             if ($s) {
3774                 $sfd{t} = $s;
3775             }
3776         }
3777         if ( $field = $host->field('260') ) {
3778             my $s = $field->as_string('abc');
3779             if ($s) {
3780                 $sfd{d} = $s;
3781             }
3782         }
3783         if ( $field = $host->field('240') ) {
3784             my $s = $field->as_string();
3785             if ($s) {
3786                 $sfd{b} = $s;
3787             }
3788         }
3789         if ( $field = $host->field('022') ) {
3790             my $s = $field->as_string('a');
3791             if ($s) {
3792                 $sfd{x} = $s;
3793             }
3794         }
3795         if ( $field = $host->field('020') ) {
3796             my $s = $field->as_string('a');
3797             if ($s) {
3798                 $sfd{z} = $s;
3799             }
3800         }
3801         if ( $field = $host->field('001') ) {
3802             $sfd{w} = $field->data(),;
3803         }
3804         $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
3805         return $host_field;
3806     }
3807     elsif ( $marcflavour eq 'UNIMARC' ) {
3808         #author
3809         if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
3810             my $s = $field->as_string('ab');
3811             if ($s) {
3812                 $sfd{a} = $s;
3813             }
3814         }
3815         #title
3816         if ( $field = $host->field('200') ) {
3817             my $s = $field->as_string('a');
3818             if ($s) {
3819                 $sfd{t} = $s;
3820             }
3821         }
3822         #place of publicaton
3823         if ( $field = $host->field('210') ) {
3824             my $s = $field->as_string('a');
3825             if ($s) {
3826                 $sfd{c} = $s;
3827             }
3828         }
3829         #date of publication
3830         if ( $field = $host->field('210') ) {
3831             my $s = $field->as_string('d');
3832             if ($s) {
3833                 $sfd{d} = $s;
3834             }
3835         }
3836         #edition statement
3837         if ( $field = $host->field('205') ) {
3838             my $s = $field->as_string();
3839             if ($s) {
3840                 $sfd{a} = $s;
3841             }
3842         }
3843         #URL
3844         if ( $field = $host->field('856') ) {
3845             my $s = $field->as_string('u');
3846             if ($s) {
3847                 $sfd{u} = $s;
3848             }
3849         }
3850         #ISSN
3851         if ( $field = $host->field('011') ) {
3852             my $s = $field->as_string('a');
3853             if ($s) {
3854                 $sfd{x} = $s;
3855             }
3856         }
3857         #ISBN
3858         if ( $field = $host->field('010') ) {
3859             my $s = $field->as_string('a');
3860             if ($s) {
3861                 $sfd{y} = $s;
3862             }
3863         }
3864         if ( $field = $host->field('001') ) {
3865             $sfd{0} = $field->data(),;
3866         }
3867         $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
3868         return $host_field;
3869     }
3870     return;
3871 }
3872
3873
3874 =head2 UpdateTotalIssues
3875
3876   UpdateTotalIssues($biblionumber, $increase, [$value])
3877
3878 Update the total issue count for a particular bib record.
3879
3880 =over 4
3881
3882 =item C<$biblionumber> is the biblionumber of the bib to update
3883
3884 =item C<$increase> is the amount to increase (or decrease) the total issues count by
3885
3886 =item C<$value> is the absolute value that total issues count should be set to. If provided, C<$increase> is ignored.
3887
3888 =back
3889
3890 =cut
3891
3892 sub UpdateTotalIssues {
3893     my ($biblionumber, $increase, $value) = @_;
3894     my $totalissues;
3895
3896     my $data = GetBiblioData($biblionumber);
3897
3898     if (defined $value) {
3899         $totalissues = $value;
3900     } else {
3901         $totalissues = $data->{'totalissues'} + $increase;
3902     }
3903      my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'});
3904
3905      my $record = GetMarcBiblio($biblionumber);
3906
3907      my $field = $record->field($totalissuestag);
3908      if (defined $field) {
3909          $field->update( $totalissuessubfield => $totalissues );
3910      } else {
3911          $field = MARC::Field->new($totalissuestag, '0', '0',
3912                  $totalissuessubfield => $totalissues);
3913          $record->insert_grouped_field($field);
3914      }
3915
3916      ModBiblio($record, $biblionumber, $data->{'frameworkcode'});
3917      return;
3918 }
3919
3920 =head2 RemoveAllNsb
3921
3922     &RemoveAllNsb($record);
3923
3924 Removes all nsb/nse chars from a record
3925
3926 =cut
3927
3928 sub RemoveAllNsb {
3929     my $record = shift;
3930
3931     SetUTF8Flag($record);
3932
3933     foreach my $field ($record->fields()) {
3934         if ($field->is_control_field()) {
3935             $field->update(nsb_clean($field->data()));
3936         } else {
3937             my @subfields = $field->subfields();
3938             my @new_subfields;
3939             foreach my $subfield (@subfields) {
3940                 push @new_subfields, $subfield->[0] => nsb_clean($subfield->[1]);
3941             }
3942             if (scalar(@new_subfields) > 0) {
3943                 my $new_field;
3944                 eval {
3945                     $new_field = MARC::Field->new(
3946                         $field->tag(),
3947                         $field->indicator(1),
3948                         $field->indicator(2),
3949                         @new_subfields
3950                     );
3951                 };
3952                 if ($@) {
3953                     warn "error in RemoveAllNsb : $@";
3954                 } else {
3955                     $field->replace_with($new_field);
3956                 }
3957             }
3958         }
3959     }
3960
3961     return $record;
3962 }
3963
3964 1;
3965
3966
3967 __END__
3968
3969 =head1 AUTHOR
3970
3971 Koha Development Team <http://koha-community.org/>
3972
3973 Paul POULAIN paul.poulain@free.fr
3974
3975 Joshua Ferraro jmf@liblime.com
3976
3977 =cut