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