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