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