C4/Biblio.pm

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