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