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