C4/Biblio.pm

   1 package C4::Biblio;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 require Exporter;
  22 use C4::Context;
  23 use C4::Database;
  24 use C4::Date;
  25 use C4::Search;
  26 use C4::Koha;
  27 use MARC::Record;
  28 use MARC::File::USMARC;
  29 use MARC::File::XML;
  30 # use Smart::Comments;
  31
  32 use ZOOM;
  33 use vars qw($VERSION @ISA @EXPORT);
  34
  35 # set the version for version checking
  36 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  37                 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  38
  39 @ISA = qw(Exporter);
  40
  41 #
  42 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
  43 # as the old-style API and the NEW one are the only public functions.
  44 #
  45 @EXPORT = qw(
  46   &newbiblio &newbiblioitem
  47   &newsubject &newsubtitle &newitems
  48
  49   &modbiblio &checkitems &modbibitem
  50   &modsubtitle &modsubject &modaddauthor &moditem
  51
  52   &delitem &deletebiblioitem &delbiblio
  53
  54   &getbiblio &bibdata &bibitems &bibitemdata
  55   &barcodes &ItemInfo &itemdata &itemissues &itemcount
  56   &getsubject &getaddauthor &getsubtitle
  57   &getwebbiblioitems &getwebsites
  58   &GetBiblioItemByBiblioNumber
  59   &getbibliofromitemnumber
  60   &getbiblioitem &getitemsbybiblioitem
  61
  62   &MARCfind_marc_from_kohafield
  63   &MARCfind_frameworkcode
  64   &find_biblioitemnumber
  65   &MARCgettagslib
  66
  67   &NEWnewbiblio &NEWnewitem
  68   &NEWmodbiblio &NEWmoditem
  69   &NEWdelbiblio &NEWdelitem
  70   &NEWmodbiblioframework
  71
  72   &MARCkoha2marcBiblio &MARCmarc2koha
  73   &MARCkoha2marcItem &MARChtml2marc &MARChtml2xml
  74   &MARCgetbiblio &MARCgetitem
  75   &MARCmoditemonefield
  76   &XMLgetbiblio
  77
  78   &FindDuplicate
  79   &DisplayISBN
  80
  81   &z3950_extended_services
  82   &set_service_options
  83
  84   &get_item_from_barcode
  85   &MARCfind_MARCbibid_from_oldbiblionumber
  86
  87   get_itemnumbers_of
  88   get_iteminfos_of
  89   get_biblioiteminfos_of
  90 );
  91
  92 =head1 NAME
  93
  94 C4::Biblio - Acquisitions, Catalog Management Functions
  95
  96 =head1 SYNOPSIS
  97
  98 ( lot of changes for Koha 3.X)
  99
 100 Koha 1.2 and previous versions used a specific API to manage biblios. This API uses old-DB style parameters.
 101 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors,
 102 bibliosubject and bibliosubtitle where applicable).
 103
 104 In Koha 2.X, we introduced a MARC-DB.
 105
 106 In Koha 3.X, we removed this MARC-DB for search as we wanted to use Zebra as search system.
 107
 108 So in Koha 3.X, saving a record means :
 109
 110  - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items information.
 111  - storing the "decoded information" in biblio/biblioitems/items as previously.
 112  - using zebra to manage search & indexing on the MARC data.
 113
 114  In Koha, there is a systempreference for "MARC=ON" or "MARC=OFF" :
 115
 116  * MARC=ON : when MARC=ON, Koha uses a MARC::Record object (in sub parameters). Saving information in the DB means :
 117
 118  - transform the MARC record into a hash
 119  - add the raw MARC record into the hash
 120  - store them & update Zebra
 121
 122  * MARC=OFF : when MARC=OFF, Koha uses a hash object (in sub parameters). Saving information in the DB means :
 123
 124  - transform the hash into a MARC record
 125  - add the raw marc record into the hash
 126  - store them & update zebra
 127
 128 That's why we need 3 types of subs :
 129
 130 =head2 REALxxx subs
 131
 132 all I<subs beginning by REAL> do the effective storage of information (with a hash, one field of the hash being the raw marc record). Those subs also update the record in Zebra. REAL subs should be only for internal use (called by NEW or "something else" subs).
 133
 134 =head2 NEWxxx related subs
 135
 136 =over 4
 137
 138 all I<subs beginning by NEW> use MARC::Record as parameters. It's the API that MUST be used in the MARC acquisition system. They just create the hash, add it the raw marc record. Then, they call REALxxx sub.
 139
 140 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. They sometimes require another parameter.
 141
 142 =back
 143
 144 =head2 something_elsexxx related subs
 145
 146 =over 4
 147
 148 all I<subs beginning by seomething else> are the old-style API. They use a hash as parameter, transform the hash into a -small- marc record, and call REAL subs.
 149
 150 all subs require/use $dbh as 1st parameter and a hash as 2nd parameter.
 151
 152 =back
 153
 154 =head1 FUNCTIONS
 155
 156 =head2 z3950_extended_services
 157
 158 z3950_extended_services($serviceType,$serviceOptions,$record);
 159
 160         z3950_extended_services is used to handle all interactions with Zebra's extended serices package.
 161
 162 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
 163
 164 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
 165
 166         action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
 167
 168 and maybe
 169
 170         recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
 171         syntax => the record syntax (transfer syntax)
 172         databaseName = Database from connection object
 173
 174         To set serviceOptions, call set_service_options($serviceType)
 175
 176 C<$record> the record, if one is needed for the service type
 177
 178         A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
 179
 180 =cut
 181 sub z3950_extended_services {
 182         my ($serviceType,$serviceOptions,$record) = @_;
 183
 184     my $Zconn = C4::Context->Zconn;
 185         # create a new package object
 186         my $Zpackage = $Zconn->package();
 187
 188         # set our options
 189         $Zpackage->option(action => $serviceOptions->{'action'});
 190
 191         if ($serviceOptions->{'databaseName'}) {
 192                 $Zpackage->option(databaseName => $serviceOptions->{'databaseName'});
 193         }
 194         if ($serviceOptions->{'recordIdNumber'}) {
 195                 $Zpackage->option(recordIdNumber => $serviceOptions->{'recordIdNumber'});
 196         }
 197         if ($serviceOptions->{'recordIdOpaque'}) {
 198                 $Zpackage->option(recordIdOpaque => $serviceOptions->{'recordIdOpaque'});
 199         }
 200
 201         # this is an ILL request (Zebra doesn't support it)
 202         #if ($serviceType eq 'itemorder') {
 203         #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
 204         #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
 205         #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
 206         #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
 207         #}
 208
 209         if ($record) {
 210                 my $xmlrecord = marc2xml($record);
 211                 $Zpackage->option(record => $xmlrecord);
 212                 if ($serviceOptions->{'syntax'}) {
 213                         $Zpackage->option(syntax => $serviceOptions->{'syntax'});
 214                 }
 215         }
 216
 217         # send the request, handle any exception encountered
 218         eval { $Zpackage->send($serviceType) };
 219                 if ($@ && $@->isa("ZOOM::Exception")) {
 220                         print "Oops!  ", $@->message(), "\n";
 221                         return $@->code();
 222                 }
 223         # free up package resources
 224         $Zpackage->destroy();
 225 }
 226
 227 =head2 set_service_options
 228
 229 my $serviceOptions = set_service_options($serviceType);
 230
 231 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
 232
 233 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
 234
 235 =cut
 236
 237 sub set_service_options {
 238         my ($serviceType,$action,$recordId) = @_;
 239         my $serviceOptions;
 240
 241         if ($serviceType eq 'update') {
 242                 if ($action) {
 243                 $serviceOptions->{ 'action' } = $action;
 244                 } else {
 245                 $serviceOptions->{ 'action' } = 'specialUpdate';
 246                 }
 247                 if ($recordId) {
 248                 $serviceOptions->{'recordIdNumber'} = $recordId;
 249                 }
 250
 251         # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
 252         #       $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
 253         }
 254
 255         if ($serviceType eq 'commit') {
 256         # nothing to do
 257
 258         }
 259         if ($serviceType eq 'create') {
 260         # nothing to do
 261         }
 262         if ($serviceType eq 'drop') {
 263                 die "ERROR: 'drop' not currently supported (by Zebra)";
 264         }
 265
 266         #check action
 267         return $serviceOptions;
 268 }
 269
 270 =head2 marc2xml
 271
 272 my $xmlrecord = marc2xml($record);
 273
 274 Convert from MARC to XML. Note that MARC::File::XML will automatically encode from MARC-8 to UTF-8 as of version .8
 275
 276 C<$record> a MARC record
 277
 278 =cut
 279
 280 sub marc2xml {
 281         my ($record) = @_;
 282         my $xmlrecord;
 283         eval { $xmlrecord=$record->as_xml_record() };
 284         #TODO: better error handling here
 285         if ($@){
 286                 warn "ERROR: I suspect a badly formatted MARC record";
 287         }
 288         return $xmlrecord;
 289 }
 290
 291 =head2 MARCgettagslib
 292
 293 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
 294
 295 =over 4
 296
 297 2nd param is 1 for liblibrarian and 0 for libopac
 298 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
 299
 300 returns a hash with all values for all fields and subfields for a given MARC framework :
 301         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 302                     ->{tab}        = "";            # XXX
 303                     ->{mandatory}  = $mandatory;
 304                     ->{repeatable} = $repeatable;
 305                     ->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 306                                  ->{tab}              = $tab;
 307                                  ->{mandatory}        = $mandatory;
 308                                  ->{repeatable}       = $repeatable;
 309                                  ->{authorised_value} = $authorised_value;
 310                                  ->{authtypecode}     = $authtypecode;
 311                                  ->{value_builder}    = $value_builder;
 312                                  ->{kohafield}        = $kohafield;
 313                                  ->{seealso}          = $seealso;
 314                                  ->{hidden}           = $hidden;
 315                                  ->{isurl}            = $isurl;
 316                                  ->{link}            = $link;
 317
 318 =back
 319
 320 =cut
 321
 322
 323 # old subroutine to provide backwards compatibility.
 324 # opac-detail breaks without this. Can be removed once opac-detail is fixed
 325 sub MARCfind_MARCbibid_from_oldbiblionumber {
 326     my ($biblionumber)=@_;
 327     return ($biblionumber);
 328
 329 }
 330
 331 sub MARCgettagslib {
 332     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
 333     $frameworkcode = "" unless $frameworkcode;
 334     $forlibrarian = 1 unless $forlibrarian;
 335     my $sth;
 336     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 337
 338     # check that framework exists
 339     $sth =
 340       $dbh->prepare(
 341         "select count(*) from marc_tag_structure where frameworkcode=?");
 342     $sth->execute($frameworkcode);
 343     my ($total) = $sth->fetchrow;
 344     $frameworkcode = "" unless ( $total > 0 );
 345     $sth =
 346       $dbh->prepare(
 347 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
 348     );
 349     $sth->execute($frameworkcode);
 350     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 351
 352     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
 353         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 354         $res->{$tag}->{tab}        = "";            # XXX
 355         $res->{$tag}->{mandatory}  = $mandatory;
 356         $res->{$tag}->{repeatable} = $repeatable;
 357     }
 358
 359     $sth =
 360       $dbh->prepare(
 361 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
 362     );
 363     $sth->execute($frameworkcode);
 364
 365     my $subfield;
 366     my $authorised_value;
 367     my $authtypecode;
 368     my $value_builder;
 369     my $kohafield;
 370     my $seealso;
 371     my $hidden;
 372     my $isurl;
 373         my $link;
 374
 375     while (
 376         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
 377         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 378         $value_builder, $kohafield,  $seealso,          $hidden,
 379         $isurl,                 $link )
 380         = $sth->fetchrow
 381       )
 382     {
 383         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 384         $res->{$tag}->{$subfield}->{tab}              = $tab;
 385         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 386         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 387         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 388         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 389         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 390         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 391         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 392         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 393         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 394         $res->{$tag}->{$subfield}->{link}            = $link;
 395     }
 396     return $res;
 397 }
 398
 399 =head2 MARCfind_marc_from_kohafield
 400
 401 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
 402
 403 =over 4
 404
 405 finds MARC tag and subfield for a given kohafield
 406 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
 407
 408 =back
 409
 410 =cut
 411
 412 sub MARCfind_marc_from_kohafield {
 413     my ( $dbh, $kohafield,$frameworkcode ) = @_;
 414     return 0, 0 unless $kohafield;
 415     $frameworkcode='' unless $frameworkcode;
 416         my $relations = C4::Context->marcfromkohafield;
 417         return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
 418 }
 419
 420 =head2 MARCgetbiblio
 421
 422 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
 423
 424 =over 4
 425
 426 Returns a MARC::Record for the biblio $biblionumber.
 427
 428 =cut
 429
 430 sub MARCgetbiblio {
 431
 432     # Returns MARC::Record of the biblio passed in parameter.
 433     my ( $dbh, $biblionumber ) = @_;
 434         my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
 435         $sth->execute($biblionumber);
 436         my ($marc) = $sth->fetchrow;
 437         my $record = MARC::Record::new_from_usmarc($marc);
 438     return $record;
 439 }
 440
 441 =head2 XMLgetbiblio
 442
 443 $XML = &XMLgetbiblio($dbh,$biblionumber);
 444
 445 =over 4
 446
 447 Returns a raw XML for the biblio $biblionumber.
 448
 449 =cut
 450
 451 sub XMLgetbiblio {
 452
 453     # Returns MARC::Record of the biblio passed in parameter.
 454     my ( $dbh, $biblionumber ) = @_;
 455         my $sth = $dbh->prepare('select marcxml,marc from biblioitems where biblionumber=?');
 456         $sth->execute($biblionumber);
 457         my ($XML,$marc) = $sth->fetchrow;
 458 #       my $record =MARC::Record::new_from_usmarc($marc);
 459 #       warn "MARC : \n*-************************\n".$record->as_xml."\n*-************************\n";
 460     return $XML;
 461 }
 462
 463 =head2 MARCgetitem
 464
 465 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
 466
 467 =over 4
 468
 469 Returns a MARC::Record with all items of biblio # $biblionumber
 470
 471 =back
 472
 473 =cut
 474
 475 sub MARCgetitem {
 476
 477     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 478         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
 479         # get the complete MARC record
 480         my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
 481         $sth->execute($biblionumber);
 482         my ($rawmarc) = $sth->fetchrow;
 483         my $record = C4::Search::get_record($biblionumber);
 484 #       warn "ITEMRECORD".$record->as_formatted;
 485         # now, find the relevant itemnumber
 486         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
 487         # prepare the new item record
 488         my $itemrecord = MARC::Record->new();
 489         # parse all fields fields from the complete record
 490         foreach ($record->field($itemnumberfield)) {
 491                 # when the item field is found, save it
 492 #               warn "Itenumberfield = $itemnumberfield";
 493                 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
 494 #                       warn "Inside if subfield=$itemnumbersubfield";
 495                         $itemrecord->append_fields($_);
 496                 } else {
 497                         warn "No match subfield=$itemnumbersubfield and
 498                                        itemnumber=$itemnumber";
 499                 }
 500         }
 501 #       warn "ITEMS".$itemrecord->as_formatted;
 502     return $itemrecord;
 503 }
 504
 505
 506 ##Changes only field or subfield from the holdings fields of MARC record used for branch transfers or onloan flag -TG
 507
 508
 509 sub MARCmoditemonefield{
 510 my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue)=@_;
 511
 512 my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
 513         # get the complete MARC record
 514         my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
 515         $sth->execute($biblionumber);
 516         my ($rawmarc) = $sth->fetchrow;
 517 my $bibliorecord=MARC::File::USMARC::decode($rawmarc);
 518         # now, find the relevant itemnumber
 519         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
 520         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,$itemfield,$frameworkcode);
 521
 522         # parse all fields fields from the complete record
 523         foreach ($bibliorecord->field($itemnumberfield)) {
 524                 # when the item field is found, update it
 525                 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
 526                         $_->update($tagsubfield =>$newvalue);
 527                 }
 528         }
 529
 530  # save the record into biblioitem
 531 $dbh->do('lock tables biblioitems WRITE');
 532         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
 533         $sth->execute($bibliorecord->as_usmarc(),$bibliorecord->as_xml_record(),$biblionumber);
 534         z3950_extended_services('update',set_service_options('update'),$bibliorecord);
 535         z3950_extended_services('commit');
 536         $dbh->do('unlock tables');
 537 }
 538
 539 =head2 find_biblioitemnumber
 540
 541 my $biblioitemnumber = find_biblioitemnumber($dbh,$biblionumber);
 542
 543 =over 4
 544
 545 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
 546 This sub is useless when MARC=OFF
 547
 548 =back
 549
 550 =cut
 551 sub find_biblioitemnumber {
 552         my ( $dbh, $biblionumber ) = @_;
 553         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 554         $sth->execute($biblionumber);
 555         my ($biblioitemnumber) = $sth->fetchrow;
 556         return $biblioitemnumber;
 557 }
 558
 559 =head2 MARCfind_frameworkcode
 560
 561 my $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
 562
 563 =over 4
 564
 565 returns the framework of a given biblio
 566
 567 =back
 568
 569 =cut
 570
 571 sub MARCfind_frameworkcode {
 572         my ( $dbh, $biblionumber ) = @_;
 573         my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
 574         $sth->execute($biblionumber);
 575         my ($frameworkcode) = $sth->fetchrow;
 576         return $frameworkcode;
 577 }
 578
 579 =head2 MARCkoha2marcBiblio
 580
 581 $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibliohash);
 582
 583 =over 4
 584
 585 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
 586 all entries of the hash are transformed into their matching MARC field/subfield.
 587
 588 =back
 589
 590 =cut
 591
 592 sub MARCkoha2marcBiblio {
 593
 594         # this function builds partial MARC::Record from the old koha-DB fields
 595         my ( $dbh, $bibliohash ) = @_;
 596         # we don't have biblio entries in the hash, so we add them first
 597         my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
 598         $sth->execute($bibliohash->{biblionumber});
 599         my $biblio = $sth->fetchrow_hashref;
 600         foreach (keys %$biblio) {
 601                 $bibliohash->{$_}=$biblio->{$_};
 602         }
 603         $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 604         my $record = MARC::Record->new();
 605         foreach ( keys %$bibliohash ) {
 606                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
 607                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
 608         }
 609
 610         # other fields => additional authors, subjects, subtitles
 611         my $sth2 = $dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
 612         $sth2->execute($bibliohash->{biblionumber});
 613         while ( my $row = $sth2->fetchrow_hashref ) {
 614                 &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", $bibliohash->{'author'},'' );
 615         }
 616         $sth2 = $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
 617         $sth2->execute($bibliohash->{biblionumber});
 618         while ( my $row = $sth2->fetchrow_hashref ) {
 619                 &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", $row->{'subject'},'' );
 620         }
 621         $sth2 = $dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
 622         $sth2->execute($bibliohash->{biblionumber});
 623         while ( my $row = $sth2->fetchrow_hashref ) {
 624                 &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", $row->{'subtitle'},'' );
 625         }
 626
 627         return $record;
 628 }
 629
 630 =head2 MARCkoha2marcItem
 631
 632 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
 633
 634 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
 635 all entries of the hash are transformed into their matching MARC field/subfield.
 636
 637 =over 4
 638
 639 =back
 640
 641 =cut
 642
 643 sub MARCkoha2marcItem {
 644
 645     # this function builds partial MARC::Record from the old koha-DB fields
 646     my ( $dbh, $item ) = @_;
 647
 648     #    my $dbh=&C4Connect;
 649     my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 650     my $record = MARC::Record->new();
 651
 652         foreach( keys %$item ) {
 653                 if ( $item->{$_} ) {
 654                         &MARCkoha2marcOnefield( $sth, $record, "items." . $_,
 655                                 $item->{$_},'' );
 656                 }
 657         }
 658     return $record;
 659 }
 660
 661 =head2 MARCkoha2marcOnefield
 662
 663 =over 4
 664
 665 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
 666
 667 =back
 668
 669 =cut
 670
 671 sub MARCkoha2marcOnefield {
 672     my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
 673     my $tagfield;
 674     my $tagsubfield;
 675     $sth->execute($frameworkcode,$kohafieldname);
 676     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
 677         if ( $record->field($tagfield) ) {
 678             my $tag = $record->field($tagfield);
 679             if ($tag) {
 680                 $tag->add_subfields( $tagsubfield, $value );
 681                 $record->delete_field($tag);
 682                 $record->add_fields($tag);
 683             }
 684         }
 685         else {
 686             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
 687         }
 688     }
 689     return $record;
 690 }
 691 =head2 MARChtml2xml
 692
 693 $XMLrecord = MARChtml2xml($rtags,$rsubfields,$rvalues,$indicator,$ind_tag);
 694
 695 transforms the parameters (coming from HTML form) into a MARC::File::XML
 696 object. parameters with r are references to arrays
 697
 698 =cut
 699 sub MARChtml2xml {
 700         my ($tags,$subfields,$values,$indicator,$ind_tag) = @_;
 701         use MARC::File::XML;
 702         my $xml= MARC::File::XML::header();
 703     my $prevvalue;
 704     my $prevtag=-1;
 705     my $first=1;
 706         my $j = -1;
 707     for (my $i=0;$i<=@$tags;$i++){
 708                 @$values[$i] =~ s/&/&amp;/g;
 709                 @$values[$i] =~ s/</&lt;/g;
 710                 @$values[$i] =~ s/>/&gt;/g;
 711                 @$values[$i] =~ s/"/&quot;/g;
 712                 @$values[$i] =~ s/'/&apos;/g;
 713
 714                 if ((@$tags[$i] ne $prevtag)){
 715                         $j++ unless (@$tags[$i] eq "");
 716                         #warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i];
 717                         if (!$first){
 718                         $xml.="</datafield>\n";
 719                                 if ((@$tags[$i] > 10) && (@$values[$i] ne "")){
 720                                                 my $ind1 = substr(@$indicator[$j],0,1);
 721                         my $ind2 = substr(@$indicator[$j],1,1);
 722                         $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 723                         $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 724                         $first=0;
 725                                 } else {
 726                         $first=1;
 727                                 }
 728             } else {
 729                         if (@$values[$i] ne "") {
 730                                 # leader
 731                                 if (@$tags[$i] eq "000") {
 732                                                 $xml.="<leader>@$values[$i]</leader>\n";
 733                                                 $first=1;
 734                                         # rest of the fixed fields
 735                                 } elsif (@$tags[$i] < 10) {
 736                                                 $xml.="<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
 737                                                 $first=1;
 738                                 } else {
 739                                                 my $ind1 = substr(@$indicator[$j],0,1);
 740                                                 my $ind2 = substr(@$indicator[$j],1,1);
 741                                                 $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 742                                                 $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 743                                                 $first=0;
 744                                 }
 745                         }
 746                         }
 747                 } else { # @$tags[$i] eq $prevtag
 748                 if (@$values[$i] eq "") {
 749                 }
 750                 else {
 751                                         if ($first){
 752                                                 my $ind1 = substr(@$indicator[$j],0,1);
 753                                                 my $ind2 = substr(@$indicator[$j],1,1);
 754                                                 $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
 755                                                 $first=0;
 756                                         }
 757                         $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
 758                                 }
 759                 }
 760                 $prevtag = @$tags[$i];
 761         }
 762         $xml.= MARC::File::XML::footer();
 763         warn $xml;
 764         return $xml
 765 }
 766
 767 =head2 MARCmarc2koha
 768
 769 $hash = &MARCmarc2koha($dbh,$MARCRecord);
 770
 771 =over 4
 772
 773 builds a hash with old-db datas from a MARC::Record
 774
 775 =back
 776
 777 =cut
 778
 779 sub MARCmarc2koha {
 780         my ($dbh,$record,$frameworkcode) = @_;
 781         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 782         my $result;
 783         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
 784         $sth2->execute;
 785         my $field;
 786         while (($field)=$sth2->fetchrow) {
 787 #               warn "biblio.".$field;
 788                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
 789         }
 790         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
 791         $sth2->execute;
 792         while (($field)=$sth2->fetchrow) {
 793                 if ($field eq 'notes') { $field = 'bnotes'; }
 794 #               warn "biblioitems".$field;
 795                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
 796         }
 797         $sth2=$dbh->prepare("SHOW COLUMNS from items");
 798         $sth2->execute;
 799         while (($field)=$sth2->fetchrow) {
 800 #               warn "items".$field;
 801                 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
 802         }
 803         # additional authors : specific
 804         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
 805         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
 806 # modify copyrightdate to keep only the 1st year found
 807         my $temp = $result->{'copyrightdate'};
 808         if ($temp){
 809                 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 810                 if ($1>0) {
 811                         $result->{'copyrightdate'} = $1;
 812                 } else { # if no cYYYY, get the 1st date.
 813                         $temp =~ m/(\d\d\d\d)/;
 814                         $result->{'copyrightdate'} = $1;
 815                 }
 816         }
 817 # modify publicationyear to keep only the 1st year found
 818         $temp = $result->{'publicationyear'};
 819         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 820         if ($1>0) {
 821                 $result->{'publicationyear'} = $1;
 822         } else { # if no cYYYY, get the 1st date.
 823                 $temp =~ m/(\d\d\d\d)/;
 824                 $result->{'publicationyear'} = $1;
 825         }
 826         return $result;
 827 }
 828
 829 sub MARCmarc2kohaOneField {
 830
 831 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
 832     my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
 833     #    warn "kohatable / $kohafield / $result / ";
 834     my $res = "";
 835     my $tagfield;
 836     my $subfield;
 837     ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
 838     foreach my $field ( $record->field($tagfield) ) {
 839                 if ($field->tag()<10) {
 840                         if ($result->{$kohafield}) {
 841                                 # Reverse array filled with elements from repeated subfields
 842                                 # from first to last to avoid last to first concatenation of
 843                                 # elements in Koha DB.  -- thd.
 844                                 $result->{$kohafield} .= " | ".reverse($field->data());
 845                         } else {
 846                                 $result->{$kohafield} = $field->data();
 847                         }
 848                 } else {
 849                         if ( $field->subfields ) {
 850                                 my @subfields = $field->subfields();
 851                                 foreach my $subfieldcount ( 0 .. $#subfields ) {
 852                                         if ($subfields[$subfieldcount][0] eq $subfield) {
 853                                                 if ( $result->{$kohafield} ) {
 854                                                         $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
 855                                                 }
 856                                                 else {
 857                                                         $result->{$kohafield} = $subfields[$subfieldcount][1];
 858                                                 }
 859                                         }
 860                                 }
 861                         }
 862                 }
 863     }
 864 #       warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
 865     return $result;
 866 }
 867
 868 =head2 NEWnewbibilio
 869
 870 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
 871
 872 =over 4
 873
 874 creates a biblio from a MARC::Record.
 875
 876 =back
 877
 878 =cut
 879
 880 sub NEWnewbiblio {
 881     my ( $dbh,$record,$frameworkcode ) = @_;
 882     my $biblionumber;
 883     my $biblioitemnumber;
 884     my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
 885         $olddata->{frameworkcode} = $frameworkcode;
 886     $biblionumber = REALnewbiblio( $dbh, $olddata );
 887         $olddata->{biblionumber} = $biblionumber;
 888         # add biblionumber into the MARC record (it's the ID for zebra)
 889         my ( $tagfield, $tagsubfield ) =
 890                                         MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
 891         # create the field
 892         my $newfield;
 893         if ($tagfield<10) {
 894                 $newfield = MARC::Field->new(
 895                         $tagfield, $biblionumber,
 896                 );
 897         } else {
 898                 $newfield = MARC::Field->new(
 899                         $tagfield, '', '', "$tagsubfield" => $biblionumber,
 900                 );
 901         }
 902         # drop old field (just in case it already exist and create new one...
 903         my $old_field = $record->field($tagfield);
 904         $record->delete_field($old_field);
 905         $record->add_fields($newfield);
 906         #Change MARC Leader to UTF-8 incase user did not set it.New M::F::XML is sensitive to this
 907         $record->encoding('UTF-8');
 908         #create the marc entry, that stores the rax marc record in Koha 3.0
 909         $olddata->{marc} = $record->as_usmarc();
 910         $olddata->{marcxml} = $record->as_xml_record();
 911         # and create biblioitem, that's all folks !
 912     $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
 913
 914     # search subtiles, addiauthors and subjects
 915     ( $tagfield, $tagsubfield ) =
 916       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
 917     my @addiauthfields = $record->field($tagfield);
 918     foreach my $addiauthfield (@addiauthfields) {
 919         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
 920         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
 921             REALmodaddauthor( $dbh, $biblionumber,
 922                 $addiauthsubfields[$subfieldcount] );
 923         }
 924     }
 925     ( $tagfield, $tagsubfield ) =
 926       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
 927     my @subtitlefields = $record->field($tagfield);
 928     foreach my $subtitlefield (@subtitlefields) {
 929         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
 930         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
 931             REALnewsubtitle( $dbh, $biblionumber,
 932                 $subtitlesubfields[$subfieldcount] );
 933         }
 934     }
 935     ( $tagfield, $tagsubfield ) =
 936       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
 937     my @subj = $record->field($tagfield);
 938     my @subjects;
 939     foreach my $subject (@subj) {
 940         my @subjsubfield = $subject->subfield($tagsubfield);
 941         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
 942             push @subjects, $subjsubfield[$subfieldcount];
 943         }
 944     }
 945     REALmodsubject( $dbh, $biblionumber, 1, @subjects );
 946     return ( $biblionumber, $biblioitemnumber );
 947 }
 948
 949 =head2 NEWmodbilbioframework
 950
 951 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
 952
 953 =over 4
 954
 955 modify the framework of a biblio
 956
 957 =back
 958
 959 =cut
 960
 961 sub NEWmodbiblioframework {
 962         my ($dbh,$biblionumber,$frameworkcode) =@_;
 963         my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
 964         $sth->execute($frameworkcode,$biblionumber);
 965         return 1;
 966 }
 967
 968 =head2 NEWmodbiblio
 969
 970 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
 971
 972 =over 4
 973
 974 modify a biblio (MARC=ON)
 975
 976 =back
 977
 978 =cut
 979
 980 sub NEWmodbiblio {
 981         my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
 982         $frameworkcode="" unless $frameworkcode;
 983 #       &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
 984         my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
 985
 986         $oldbiblio->{frameworkcode} = $frameworkcode;
 987         #create the marc entry, that stores the rax marc record in Koha 3.0
 988         $oldbiblio->{biblionumber} = $biblionumber unless $oldbiblio->{biblionumber};
 989         $oldbiblio->{marc} = $record->as_usmarc();
 990         $oldbiblio->{marcxml} = $record->as_xml_record();
 991         warn "dans NEWmodbiblio $biblionumber = ".$oldbiblio->{biblionumber}." = ".$oldbiblio->{marcxml};
 992         REALmodbiblio($dbh,$oldbiblio);
 993         REALmodbiblioitem($dbh,$oldbiblio);
 994         # now, modify addi authors, subject, addititles.
 995         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
 996         my @addiauthfields = $record->field($tagfield);
 997         foreach my $addiauthfield (@addiauthfields) {
 998                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
 999                 $dbh->do("delete from additionalauthors where biblionumber=$biblionumber");
1000                 foreach my $subfieldcount (0..$#addiauthsubfields) {
1001                         REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
1002                 }
1003         }
1004         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
1005         my @subtitlefields = $record->field($tagfield);
1006         foreach my $subtitlefield (@subtitlefields) {
1007                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
1008                 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
1009                 # between 2 modifs
1010                 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
1011                 foreach my $subfieldcount (0..$#subtitlesubfields) {
1012                         foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
1013                                 REALnewsubtitle($dbh,$biblionumber,$subtit);
1014                         }
1015                 }
1016         }
1017         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
1018         my @subj = $record->field($tagfield);
1019         my @subjects;
1020         foreach my $subject (@subj) {
1021                 my @subjsubfield = $subject->subfield($tagsubfield);
1022                 foreach my $subfieldcount (0..$#subjsubfield) {
1023                         push @subjects,$subjsubfield[$subfieldcount];
1024                 }
1025         }
1026         REALmodsubject($dbh,$biblionumber,1,@subjects);
1027         return 1;
1028 }
1029
1030 =head2 NEWmodbilbioframework
1031
1032 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
1033
1034 =over 4
1035
1036 delete a biblio
1037
1038 =back
1039
1040 =cut
1041
1042 sub NEWdelbiblio {
1043     my ( $dbh, $bibid ) = @_;
1044 #    my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
1045     &REALdelbiblio( $dbh, $bibid );
1046     my $sth =
1047       $dbh->prepare(
1048         "select biblioitemnumber from biblioitems where biblionumber=?");
1049     $sth->execute($bibid);
1050     while ( my ($biblioitemnumber) = $sth->fetchrow ) {
1051         REALdelbiblioitem( $dbh, $biblioitemnumber );
1052     }
1053 #    &MARCdelbiblio( $dbh, $bibid, 0 );
1054     # delete from zebra
1055     warn "heres the bibid $bibid";
1056 #    my $record = C4::Search::get_record($bibid);
1057     my $record = C4::Search::get_xml_record($bibid);
1058 #    z3950_extended_services('update',set_service_options('update'),$record);
1059     warn "heres the record to delete $bibid";
1060     my $Zconn = C4::Context->Zconn;
1061     my $p = $Zconn->package();
1062     $p->option(action => "recordDelete");
1063     $p->option(record => $record);
1064     $p->send("update");
1065     $p->destroy();
1066 #    z3950_extended_services('update',set_service_options('update','recordDelete',$record));
1067     z3950_extended_services('commit');
1068 }
1069
1070 =head2 NEWnewitem
1071
1072 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
1073
1074 =over 4
1075
1076 creates an item from a MARC::Record
1077
1078 =back
1079
1080 =cut
1081
1082 sub NEWnewitem {
1083     my ( $dbh,$record,$biblionumber,$biblioitemnumber ) = @_;
1084     warn "here is the $biblioitemnumber";
1085     # add item in old-DB
1086         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1087     my $item = &MARCmarc2koha( $dbh,$record,$frameworkcode );
1088     # needs old biblionumber and biblioitemnumber
1089     $item->{'biblionumber'} = $biblionumber;
1090     $item->{'biblioitemnumber'}=$biblioitemnumber;
1091     $item->{marc} = $record->as_usmarc();
1092     #warn $item->{marc};
1093     my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
1094         return $itemnumber;
1095 }
1096
1097
1098 =head2 NEWmoditem
1099
1100 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
1101
1102 =over 4
1103
1104 Modify an item
1105
1106 =back
1107
1108 =cut
1109
1110 sub NEWmoditem {
1111     my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
1112
1113         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
1114     my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
1115         # add MARC record
1116         $olditem->{marc} = $record->as_usmarc();
1117         $olditem->{biblionumber} = $biblionumber;
1118         $olditem->{biblioitemnumber} = $biblioitemnumber;
1119         # and modify item
1120     REALmoditem( $dbh, $olditem );
1121 }
1122
1123
1124 =head2 NEWdelitem
1125
1126 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
1127
1128 =over 4
1129
1130 delete an item
1131
1132 =back
1133
1134 =cut
1135
1136 sub NEWdelitem {
1137     my ( $dbh, $bibid, $itemnumber ) = @_;
1138     &REALdelitem( $dbh, $itemnumber );
1139 #    &MARCdelitem( $dbh, $bibid, $itemnumber );
1140     # we must now delete the item data from zebra
1141 }
1142
1143
1144 =head2 REALnewbiblio
1145
1146 $biblionumber = REALnewbiblio($dbh,$biblio);
1147
1148 =over 4
1149
1150 adds a record in biblio table. Datas are in the hash $biblio.
1151
1152 =back
1153
1154 =cut
1155
1156 sub REALnewbiblio {
1157     my ( $dbh, $biblio ) = @_;
1158
1159         $dbh->do('lock tables biblio WRITE');
1160     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1161     $sth->execute;
1162     my $data   = $sth->fetchrow_arrayref;
1163     my $bibnum = $$data[0] + 1;
1164     my $series = 0;
1165
1166     if ( $biblio->{'seriestitle'} ) { $series = 1 }
1167     $sth->finish;
1168     $sth =
1169       $dbh->prepare("insert into biblio set     biblionumber=?, title=?,                author=?,       copyrightdate=?,
1170                                                                                         serial=?,               seriestitle=?,  notes=?,        abstract=?,
1171                                                                                         unititle=?"
1172     );
1173     $sth->execute(
1174         $bibnum,             $biblio->{'title'},
1175         $biblio->{'author'}, $biblio->{'copyrightdate'},
1176         $biblio->{'serial'},             $biblio->{'seriestitle'},
1177         $biblio->{'notes'},  $biblio->{'abstract'},
1178                 $biblio->{'unititle'}
1179     );
1180
1181     $sth->finish;
1182         $dbh->do('unlock tables');
1183     return ($bibnum);
1184 }
1185
1186 =head2 REALmodbiblio
1187
1188 $biblionumber = REALmodbiblio($dbh,$biblio);
1189
1190 =over 4
1191
1192 modify a record in biblio table. Datas are in the hash $biblio.
1193
1194 =back
1195
1196 =cut
1197
1198 sub REALmodbiblio {
1199     my ( $dbh, $biblio ) = @_;
1200     my $sth = $dbh->prepare("Update biblio set  title=?,                author=?,       abstract=?,     copyrightdate=?,
1201                                                                                                 seriestitle=?,  serial=?,       unititle=?,     notes=?,        frameworkcode=?
1202                                                                                         where biblionumber = ?"
1203     );
1204     $sth->execute(
1205                 $biblio->{'title'},       $biblio->{'author'},
1206                 $biblio->{'abstract'},    $biblio->{'copyrightdate'},
1207                 $biblio->{'seriestitle'}, $biblio->{'serial'},
1208                 $biblio->{'unititle'},    $biblio->{'notes'},
1209                 $biblio->{frameworkcode},
1210                 $biblio->{'biblionumber'}
1211     );
1212         $sth->finish;
1213         return ( $biblio->{'biblionumber'} );
1214 }    # sub modbiblio
1215
1216 =head2 REALmodsubtitle
1217
1218 REALmodsubtitle($dbh,$bibnum,$subtitle);
1219
1220 =over 4
1221
1222 modify subtitles in bibliosubtitle table.
1223
1224 =back
1225
1226 =cut
1227
1228 sub REALmodsubtitle {
1229     my ( $dbh, $bibnum, $subtitle ) = @_;
1230     my $sth =
1231       $dbh->prepare(
1232         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1233     $sth->execute( $subtitle, $bibnum );
1234     $sth->finish;
1235 }    # sub modsubtitle
1236
1237 =head2 REALmodaddauthor
1238
1239 REALmodaddauthor($dbh,$bibnum,$author);
1240
1241 =over 4
1242
1243 adds or modify additional authors
1244 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1245
1246 =back
1247
1248 =cut
1249
1250 sub REALmodaddauthor {
1251     my ( $dbh, $bibnum, @authors ) = @_;
1252
1253     #    my $dbh   = C4Connect;
1254     my $sth =
1255       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1256
1257     $sth->execute($bibnum);
1258     $sth->finish;
1259     foreach my $author (@authors) {
1260         if ( $author ne '' ) {
1261             $sth =
1262               $dbh->prepare(
1263                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1264             );
1265
1266             $sth->execute( $author, $bibnum );
1267
1268             $sth->finish;
1269         }    # if
1270     }
1271 }    # sub modaddauthor
1272
1273 =head2 REALmodsubject
1274
1275 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1276
1277 =over 4
1278
1279 modify/adds subjects
1280
1281 =back
1282
1283 =cut
1284 sub REALmodsubject {
1285     my ( $dbh, $bibnum, $force, @subject ) = @_;
1286
1287     #  my $dbh   = C4Connect;
1288     my $count = @subject;
1289     my $error="";
1290     for ( my $i = 0 ; $i < $count ; $i++ ) {
1291         $subject[$i] =~ s/^ //g;
1292         $subject[$i] =~ s/ $//g;
1293         my $sth =
1294           $dbh->prepare(
1295 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1296         );
1297         $sth->execute( $subject[$i] );
1298
1299         if ( my $data = $sth->fetchrow_hashref ) {
1300         }
1301         else {
1302             if ( $force eq $subject[$i] || $force == 1 ) {
1303
1304                 # subject not in aut, chosen to force anway
1305                 # so insert into cataloguentry so its in auth file
1306                 my $sth2 =
1307                   $dbh->prepare(
1308 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1309                 );
1310
1311                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1312                 $sth2->finish;
1313             }
1314             else {
1315                 $error =
1316                   "$subject[$i]\n does not exist in the subject authority file";
1317                 my $sth2 =
1318                   $dbh->prepare(
1319 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1320                 );
1321                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1322                     "% $subject[$i]" );
1323                 while ( my $data = $sth2->fetchrow_hashref ) {
1324                     $error .= "<br>$data->{'catalogueentry'}";
1325                 }    # while
1326                 $sth2->finish;
1327             }    # else
1328         }    # else
1329         $sth->finish;
1330     }    # else
1331     if ($error eq '') {
1332         my $sth =
1333           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1334         $sth->execute($bibnum);
1335         $sth->finish;
1336         $sth =
1337           $dbh->prepare(
1338             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1339         my $query;
1340         foreach $query (@subject) {
1341             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1342         }    # foreach
1343         $sth->finish;
1344     }    # if
1345
1346     #  $dbh->disconnect;
1347     return ($error);
1348 }    # sub modsubject
1349
1350 =head2 REALmodbiblioitem
1351
1352 REALmodbiblioitem($dbh, $biblioitem);
1353
1354 =over 4
1355
1356 modify a biblioitem
1357
1358 =back
1359
1360 =cut
1361 sub REALmodbiblioitem {
1362     my ( $dbh, $biblioitem ) = @_;
1363     my $query;
1364
1365     my $sth = $dbh->prepare("update biblioitems set number=?,volume=?,                  volumedate=?,           lccn=?,
1366                                                                                 itemtype=?,                     url=?,                          isbn=?,                         issn=?,
1367                                                                                 publishercode=?,        publicationyear=?,      classification=?,       dewey=?,
1368                                                                                 subclass=?,                     illus=?,                        pages=?,                        volumeddesc=?,
1369                                                                                 notes=?,                        size=?,                         place=?,                        marc=?,
1370                                                                                 marcxml=?
1371                                                         where biblioitemnumber=?");
1372         $sth->execute(  $biblioitem->{number},                  $biblioitem->{volume},  $biblioitem->{volumedate},      $biblioitem->{lccn},
1373                                         $biblioitem->{itemtype},                $biblioitem->{url},             $biblioitem->{isbn},    $biblioitem->{issn},
1374                                 $biblioitem->{publishercode},   $biblioitem->{publicationyear}, $biblioitem->{classification},  $biblioitem->{dewey},
1375                                 $biblioitem->{subclass},                $biblioitem->{illus},           $biblioitem->{pages},   $biblioitem->{volumeddesc},
1376                                 $biblioitem->{bnotes},                  $biblioitem->{size},            $biblioitem->{place},   $biblioitem->{marc},
1377                                         $biblioitem->{marcxml},                 $biblioitem->{biblioitemnumber});
1378
1379         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1380
1381         z3950_extended_services('update',set_service_options('update'),$record);
1382         z3950_extended_services('commit');
1383
1384
1385 #       warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1386 }    # sub modbibitem
1387
1388 =head2 REALnewbiblioitem
1389
1390 REALnewbiblioitem($dbh,$biblioitem);
1391
1392 =over 4
1393
1394 adds a biblioitem ($biblioitem is a hash with the values)
1395
1396 =back
1397
1398 =cut
1399
1400 sub REALnewbiblioitem {
1401         my ( $dbh, $biblioitem ) = @_;
1402
1403         $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1404         my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1405         my $data;
1406         my $biblioitemnumber;
1407
1408         $sth->execute;
1409         $data       = $sth->fetchrow_arrayref;
1410         $biblioitemnumber = $$data[0] + 1;
1411
1412         # Insert biblioitemnumber in MARC record, we need it to manage items later...
1413         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1414         my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1415         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1416         my $field=$record->field($biblioitemnumberfield);
1417         $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1418         $biblioitem->{marc} = $record->as_usmarc();
1419         $biblioitem->{marcxml} = $record->as_xml_record();
1420
1421         $sth = $dbh->prepare( "insert into biblioitems set
1422                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1423                                                                         volume           = ?,                   number           = ?,
1424                                                                         classification  = ?,                    itemtype         = ?,
1425                                                                         url              = ?,                           isbn             = ?,
1426                                                                         issn             = ?,                           dewey            = ?,
1427                                                                         subclass         = ?,                           publicationyear  = ?,
1428                                                                         publishercode    = ?,           volumedate       = ?,
1429                                                                         volumeddesc      = ?,           illus            = ?,
1430                                                                         pages            = ?,                           notes            = ?,
1431                                                                         size             = ?,                           lccn             = ?,
1432                                                                         marc             = ?,                           place            = ?,
1433                                                                         marcxml          = ?"
1434         );
1435         $sth->execute(
1436                 $biblioitemnumber,               $biblioitem->{'biblionumber'},
1437                 $biblioitem->{'volume'},         $biblioitem->{'number'},
1438                 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1439                 $biblioitem->{'url'},            $biblioitem->{'isbn'},
1440                 $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1441                 $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1442                 $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1443                 $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1444                 $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1445                 $biblioitem->{'size'},           $biblioitem->{'lccn'},
1446                 $biblioitem->{'marc'},           $biblioitem->{'place'},
1447                 $biblioitem->{marcxml},
1448         );
1449         $dbh->do("unlock tables");
1450         z3950_extended_services('update',set_service_options('update'),$record);
1451         z3950_extended_services('commit');
1452         return ($biblioitemnumber);
1453 }
1454
1455 =head2 REALnewsubtitle
1456
1457 REALnewsubtitle($dbh,$bibnum,$subtitle);
1458
1459 =over 4
1460
1461 create a new subtitle
1462
1463 =back
1464
1465 =cut
1466 sub REALnewsubtitle {
1467     my ( $dbh, $bibnum, $subtitle ) = @_;
1468     my $sth =
1469       $dbh->prepare(
1470         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1471     $sth->execute( $bibnum, $subtitle ) if $subtitle;
1472     $sth->finish;
1473 }
1474
1475 =head2 REALnewitems
1476
1477 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1478
1479 =over 4
1480
1481 create a item. $item is a hash and $barcode the barcode.
1482
1483 =back
1484
1485 =cut
1486
1487 sub REALnewitems {
1488     my ( $dbh, $item, $barcode ) = @_;
1489
1490 #       warn "OLDNEWITEMS";
1491
1492         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE,marc_subfield_structure WRITE');
1493     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1494     my $data;
1495     my $itemnumber;
1496     my $error = "";
1497     $sth->execute;
1498     $data       = $sth->fetchrow_hashref;
1499     $itemnumber = $data->{'max(itemnumber)'} + 1;
1500
1501 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1502     if ( $item->{'loan'} ) {
1503         $item->{'notforloan'} = $item->{'loan'};
1504     }
1505 #       $item->{'biblioitemnumber'} = 1;
1506     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1507     if ( $item->{'dateaccessioned'} ) {
1508         $sth = $dbh->prepare( "Insert into items set
1509                                                         itemnumber           = ?,                       biblionumber         = ?,
1510                                                         multivolumepart      = ?,
1511                                                         biblioitemnumber     = ?,                       barcode              = ?,
1512                                                         booksellerid         = ?,                       dateaccessioned      = ?,
1513                                                         homebranch           = ?,                       holdingbranch        = ?,
1514                                                         price                = ?,                       replacementprice     = ?,
1515                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1516                                                         multivolume                     = ?,                    stack                           = ?,
1517                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1518                                                         paidfor                         = ?,                    itemnotes            = ?,
1519                                                         itemcallnumber  =?,                                                     notforloan = ?,
1520                                                         location = ?
1521                                                         "
1522         );
1523         $sth->execute(
1524                         $itemnumber,                            $item->{'biblionumber'},
1525                         $item->{'multivolumepart'},
1526                         $item->{'biblioitemnumber'},$item->{barcode},
1527                         $item->{'booksellerid'},        $item->{'dateaccessioned'},
1528                         $item->{'homebranch'},          $item->{'holdingbranch'},
1529                         $item->{'price'},                       $item->{'replacementprice'},
1530                         $item->{multivolume},           $item->{stack},
1531                         $item->{itemlost},                      $item->{wthdrawn},
1532                         $item->{paidfor},                       $item->{'itemnotes'},
1533                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1534                         $item->{'location'}
1535         );
1536                 if ( defined $sth->errstr ) {
1537                         $error .= $sth->errstr;
1538                 }
1539     }
1540     else {
1541         $sth = $dbh->prepare( "Insert into items set
1542                                                         itemnumber           = ?,                       biblionumber         = ?,
1543                                                         multivolumepart      = ?,
1544                                                         biblioitemnumber     = ?,                       barcode              = ?,
1545                                                         booksellerid         = ?,                       dateaccessioned      = NOW(),
1546                                                         homebranch           = ?,                       holdingbranch        = ?,
1547                                                         price                = ?,                       replacementprice     = ?,
1548                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1549                                                         multivolume                     = ?,                    stack                           = ?,
1550                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1551                                                         paidfor                         = ?,                    itemnotes            = ?,
1552                                                         itemcallnumber  =?,                                                     notforloan = ?,
1553                                                         location = ?
1554                                                         "
1555         );
1556         $sth->execute(
1557                         $itemnumber,                            $item->{'biblionumber'},
1558                         $item->{'multivolumepart'},
1559                         $item->{'biblioitemnumber'},$item->{barcode},
1560                         $item->{'booksellerid'},
1561                         $item->{'homebranch'},          $item->{'holdingbranch'},
1562                         $item->{'price'},                       $item->{'replacementprice'},
1563                         $item->{multivolume},           $item->{stack},
1564                         $item->{itemlost},                      $item->{wthdrawn},
1565                         $item->{paidfor},                       $item->{'itemnotes'},
1566                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1567                         $item->{'location'}
1568         );
1569                 if ( defined $sth->errstr ) {
1570                         $error .= $sth->errstr;
1571                 }
1572     }
1573         # item stored, now, deal with the marc part...
1574         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1575                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1576                                                                         biblio.biblionumber=?");
1577         $sth->execute($item->{biblionumber});
1578     if ( defined $sth->errstr ) {
1579         $error .= $sth->errstr;
1580     }
1581         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1582         warn "ERROR IN REALnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1583         my $record = MARC::File::USMARC::decode($rawmarc);
1584         # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1585         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1586         my $itemrecord = MARC::Record->new_from_usmarc($item->{marc});
1587         #warn $itemrecord;
1588         #warn $itemnumberfield;
1589         #warn $itemrecord->field($itemnumberfield);
1590         my $itemfield = $itemrecord->field($itemnumberfield);
1591         $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1592         $record->insert_grouped_field($itemfield);
1593         # save the record into biblioitem
1594         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1595         $sth->execute($record->as_usmarc(),$record->as_xml_record(),$item->{biblionumber});
1596     if ( defined $sth->errstr ) {
1597         $error .= $sth->errstr;
1598     }
1599         z3950_extended_services('update',set_service_options('update'),$record);
1600         z3950_extended_services('commit');
1601         $dbh->do('unlock tables');
1602     return ( $itemnumber, $error );
1603 }
1604
1605 =head2 REALmoditem($dbh,$item);
1606
1607 =over 4
1608
1609 modify item
1610
1611 =back
1612
1613 =cut
1614
1615 sub REALmoditem {
1616     my ( $dbh, $item ) = @_;
1617     $item->{'bibitemnum'} = 1;
1618         my $error;
1619         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1620     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1621     my $query = "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1622     my @bind = (
1623         $item->{'barcode'},                     $item->{'itemnotes'},
1624         $item->{'itemcallnumber'},      $item->{'notforloan'},
1625         $item->{'location'},            $item->{multivolumepart},
1626                 $item->{multivolume},           $item->{stack},
1627                 $item->{wthdrawn},
1628     );
1629     if ( $item->{'lost'} ne '' ) {
1630         $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1631                                                         itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1632                                                         location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1633         @bind = (
1634             $item->{'bibitemnum'},     $item->{'barcode'},
1635             $item->{'itemnotes'},          $item->{'homebranch'},
1636             $item->{'lost'},           $item->{'wthdrawn'},
1637             $item->{'itemcallnumber'}, $item->{'notforloan'},
1638             $item->{'location'},                $item->{multivolumepart},
1639                         $item->{multivolume},           $item->{stack},
1640                         $item->{wthdrawn},
1641         );
1642                 if ($item->{homebranch}) {
1643                         $query.=",homebranch=?";
1644                         push @bind, $item->{homebranch};
1645                 }
1646                 if ($item->{holdingbranch}) {
1647                         $query.=",holdingbranch=?";
1648                         push @bind, $item->{holdingbranch};
1649                 }
1650     }
1651         $query.=" where itemnumber=?";
1652         push @bind,$item->{'itemnum'};
1653    if ( $item->{'replacement'} ne '' ) {
1654         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1655     }
1656     my $sth = $dbh->prepare($query);
1657     $sth->execute(@bind);
1658
1659         # item stored, now, deal with the marc part...
1660         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1661                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1662                                                                         biblio.biblionumber=? and
1663                                                                         biblioitems.biblioitemnumber=?");
1664         $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1665     if ( defined $sth->errstr ) {
1666         $error .= $sth->errstr;
1667     }
1668         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1669 #       warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1670 #       my $record = MARC::File::USMARC::decode($rawmarc);
1671         my $record=C4::Search::get_record($item->{biblionumber});
1672 ####$record
1673         # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1674         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1675         # prepare the new item record
1676         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1677         my $itemfield = $itemrecord->field($itemnumberfield);
1678
1679 #       $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1680         # parse all fields fields from the complete record
1681         foreach ($record->field($itemnumberfield)) {
1682                 # when the previous field is found, replace by the new one
1683                 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1684                         $_->replace_with($itemfield);
1685                 }
1686             else {
1687                 my $temptest = $_->subfield($itemnumbersubfield);
1688                 warn " failed itemnum is $item->{itemnum} and value in record is $temptest";
1689                 }
1690         }
1691 #       $record->insert_grouped_field($itemfield);
1692         # save the record into biblioitem
1693         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1694         $sth->execute($record->as_usmarc(),$record->as_xml_record(),$item->{biblionumber},$item->{biblioitemnumber});
1695         z3950_extended_services('update',set_service_options('update'),$record);
1696         z3950_extended_services('commit');
1697     if ( defined $sth->errstr ) {
1698         $error .= $sth->errstr;
1699     }
1700         $dbh->do('unlock tables');
1701
1702 }
1703
1704 =head2 REALdelitem($dbh,$itemnum);
1705
1706 =over 4
1707
1708 delete item
1709
1710 =back
1711
1712 =cut
1713
1714 sub REALdelitem {
1715     my ( $dbh, $itemnum ) = @_;
1716
1717     #  my $dbh=C4Connect;
1718     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1719     $sth->execute($itemnum);
1720     my $data = $sth->fetchrow_hashref;
1721     $sth->finish;
1722     my $query = "Insert into deleteditems set ";
1723     my @bind  = ();
1724     foreach my $temp ( keys %$data ) {
1725         $query .= "$temp = ?,";
1726         push ( @bind, $data->{$temp} );
1727     }
1728     $query =~ s/\,$//;
1729
1730     #  print $query;
1731     $sth = $dbh->prepare($query);
1732     $sth->execute(@bind);
1733     $sth->finish;
1734     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1735     $sth->execute($itemnum);
1736     $sth->finish;
1737
1738     #  $dbh->disconnect;
1739 }
1740
1741 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1742
1743 =over 4
1744
1745 deletes a biblioitem
1746 NOTE : not standard sub name. Should be REALdelbiblioitem()
1747
1748 =back
1749
1750 =cut
1751
1752 sub REALdelbiblioitem {
1753     my ( $dbh, $biblioitemnumber ) = @_;
1754
1755     #    my $dbh   = C4Connect;
1756     my $sth = $dbh->prepare( "Select * from biblioitems
1757 where biblioitemnumber = ?"
1758     );
1759     my $results;
1760
1761     $sth->execute($biblioitemnumber);
1762
1763     if ( $results = $sth->fetchrow_hashref ) {
1764         $sth->finish;
1765         $sth =
1766           $dbh->prepare(
1767 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1768                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1769                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1770         );
1771
1772         $sth->execute(
1773             $results->{biblioitemnumber}, $results->{biblionumber},
1774             $results->{volume},           $results->{number},
1775             $results->{classification},   $results->{itemtype},
1776             $results->{isbn},             $results->{issn},
1777             $results->{dewey},            $results->{subclass},
1778             $results->{publicationyear},  $results->{publishercode},
1779             $results->{volumedate},       $results->{volumeddesc},
1780             $results->{timestamp},        $results->{illus},
1781             $results->{pages},            $results->{notes},
1782             $results->{size},             $results->{url},
1783             $results->{lccn}
1784         );
1785         my $sth2 =
1786           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1787         $sth2->execute($biblioitemnumber);
1788         $sth2->finish();
1789     }    # if
1790     $sth->finish;
1791
1792     # Now delete all the items attached to the biblioitem
1793     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1794     $sth->execute($biblioitemnumber);
1795     my @results;
1796     while ( my $data = $sth->fetchrow_hashref ) {
1797         my $query = "Insert into deleteditems set ";
1798         my @bind  = ();
1799         foreach my $temp ( keys %$data ) {
1800                         next if ($temp =~/itemcallnumber/);
1801             $query .= "$temp = ?,";
1802             push ( @bind, $data->{$temp} );
1803         }
1804         $query =~ s/\,$//;
1805         my $sth2 = $dbh->prepare($query);
1806         $sth2->execute(@bind);
1807     }    # while
1808     $sth->finish;
1809     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1810     $sth->execute($biblioitemnumber);
1811     $sth->finish();
1812
1813     #    $dbh->disconnect;
1814 }    # sub deletebiblioitem
1815
1816 =head2 REALdelbiblio($dbh,$biblio);
1817
1818 =over 4
1819
1820 delete a biblio
1821
1822 =back
1823
1824 =cut
1825
1826 sub REALdelbiblio {
1827     my ( $dbh, $biblio ) = @_;
1828     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1829     $sth->execute($biblio);
1830     if ( my $data = $sth->fetchrow_hashref ) {
1831         $sth->finish;
1832         my $query = "Insert into deletedbiblio set ";
1833         my @bind  = ();
1834         foreach my $temp ( keys %$data ) {
1835             $query .= "$temp = ?,";
1836             push ( @bind, $data->{$temp} );
1837         }
1838
1839         #replacing the last , by ",?)"
1840         $query =~ s/\,$//;
1841         $sth = $dbh->prepare($query);
1842         $sth->execute(@bind);
1843         $sth->finish;
1844         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1845         $sth->execute($biblio);
1846         $sth->finish;
1847     }
1848     $sth->finish;
1849 }
1850
1851 =head2 itemcount
1852
1853 $number = itemcount($biblio);
1854
1855 =over 4
1856
1857 returns the number of items attached to a biblio
1858
1859 =back
1860
1861 =cut
1862
1863 sub itemcount {
1864     my ($biblio) = @_;
1865     my $dbh = C4::Context->dbh;
1866
1867     #  print $query;
1868     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1869     $sth->execute($biblio);
1870     my $data = $sth->fetchrow_hashref;
1871     $sth->finish;
1872     return ( $data->{'count(*)'} );
1873 }
1874
1875 =head2 newbiblio
1876
1877 $biblionumber = newbiblio($biblio);
1878
1879 =over 4
1880
1881 create a biblio. The parameter is a hash
1882
1883 =back
1884
1885 =cut
1886
1887 sub newbiblio {
1888     my ($biblio) = @_;
1889     my $dbh    = C4::Context->dbh;
1890     my $bibnum = REALnewbiblio( $dbh, $biblio );
1891     # finds new (MARC bibid
1892     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1893 #     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1894 #     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1895     return ($bibnum);
1896 }
1897
1898 =head2  modbiblio
1899
1900 $biblionumber = &modbiblio($biblio);
1901
1902 =over 4
1903
1904 Update a biblio record.
1905
1906 C<$biblio> is a reference-to-hash whose keys are the fields in the
1907 biblio table in the Koha database. All fields must be present, not
1908 just the ones you wish to change.
1909
1910 C<&modbiblio> updates the record defined by
1911 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1912
1913 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1914 successful or not.
1915
1916 =back
1917
1918 =cut
1919
1920 sub modbiblio {
1921         my ($biblio) = @_;
1922         my $dbh  = C4::Context->dbh;
1923         my $biblionumber=REALmodbiblio($dbh,$biblio);
1924         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1925         # finds new (MARC bibid
1926         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1927         MARCmodbiblio($dbh,$bibid,$record,"",0);
1928         return($biblionumber);
1929 } # sub modbiblio
1930
1931 =head2 &modsubtitle($biblionumber, $subtitle);
1932
1933 =over 4
1934
1935 Sets the subtitle of a book.
1936
1937 C<$biblionumber> is the biblionumber of the book to modify.
1938
1939 C<$subtitle> is the new subtitle.
1940
1941 =back
1942
1943 =cut
1944
1945 sub modsubtitle {
1946     my ( $bibnum, $subtitle ) = @_;
1947     my $dbh = C4::Context->dbh;
1948     &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1949 }    # sub modsubtitle
1950
1951 =head2 &modaddauthor($biblionumber, $author);
1952
1953 =over 4
1954
1955 Replaces all additional authors for the book with biblio number
1956 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1957 C<&modaddauthor> deletes all additional authors.
1958
1959 =back
1960
1961 =cut
1962
1963 sub modaddauthor {
1964     my ( $bibnum, @authors ) = @_;
1965     my $dbh = C4::Context->dbh;
1966     &REALmodaddauthor( $dbh, $bibnum, @authors );
1967 }    # sub modaddauthor
1968
1969 =head2 modsubject
1970
1971 $error = &modsubject($biblionumber, $force, @subjects);
1972
1973 =over 4
1974
1975 $force - a subject to force
1976 $error - Error message, or undef if successful.
1977
1978 =back
1979
1980 =cut
1981
1982 sub modsubject {
1983     my ( $bibnum, $force, @subject ) = @_;
1984     my $dbh = C4::Context->dbh;
1985     my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1986     if ($error eq ''){
1987                 # When MARC is off, ensures that the MARC biblio table gets updated with new
1988                 # subjects, of course, it deletes the biblio in marc, and then recreates.
1989                 # This check is to ensure that no MARC data exists to lose.
1990 #               if (C4::Context->preference("MARC") eq '0'){
1991 #               warn "in modSUBJECT";
1992 #                       my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1993 #                       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1994 #                       &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1995 #               }
1996         }
1997         return ($error);
1998 }    # sub modsubject
1999
2000 =head2 modbibitem($dbh, $biblioitem);
2001
2002 =over 4
2003
2004 modify a biblioitem. The parameter is a hash
2005
2006 =back
2007
2008 =cut
2009
2010 sub modbibitem {
2011     my ($dbh, $biblioitem) = @_;
2012     #my $dbh = C4::Context->dbh;
2013     &REALmodbiblioitem( $dbh, $biblioitem );
2014 }    # sub modbibitem
2015
2016 =head2 newbiblioitem
2017
2018 $biblioitemnumber = newbiblioitem($biblioitem)
2019
2020 =over 4
2021
2022 create a biblioitem, the parameter is a hash
2023
2024 =back
2025
2026 =cut
2027
2028 sub newbiblioitem {
2029     my ($biblioitem) = @_;
2030     my $dbh        = C4::Context->dbh;
2031         # add biblio information to the hash
2032     my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
2033         $biblioitem->{marc} = $MARCbiblio->as_usmarc();
2034     my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
2035     return ($bibitemnum);
2036 }
2037
2038 =head2 newsubtitle($biblionumber,$subtitle);
2039
2040 =over 4
2041
2042 insert a subtitle for $biblionumber biblio
2043
2044 =back
2045
2046 =cut
2047
2048
2049 sub newsubtitle {
2050     my ( $bibnum, $subtitle ) = @_;
2051     my $dbh = C4::Context->dbh;
2052     &REALnewsubtitle( $dbh, $bibnum, $subtitle );
2053 }
2054
2055 =head2 newitems
2056
2057 $errors = newitems($dbh, $item, @barcodes);
2058
2059 =over 4
2060
2061 insert items ($item is a hash)
2062
2063 =back
2064
2065 =cut
2066
2067
2068 sub newitems {
2069     my ( $dbh, $item, @barcodes ) = @_;
2070     #my $dbh = C4::Context->dbh;
2071     my $errors;
2072     my $itemnumber;
2073     my $error;
2074     foreach my $barcode (@barcodes) {
2075                 # add items, one by one for each barcode.
2076                 my $oneitem=$item;
2077                 $oneitem->{barcode}= $barcode;
2078         my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
2079                 $oneitem->{marc} = $MARCitem->as_usmarc;
2080         ( $itemnumber, $error ) = &REALnewitems( $dbh, $oneitem);
2081 #         $errors .= $error;
2082 #         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
2083     }
2084     return ($errors);
2085 }
2086
2087 =head2 moditem($dbh,$item);
2088
2089 =over 4
2090
2091 modify an item ($item is a hash with all item informations)
2092
2093 =back
2094
2095 =cut
2096
2097
2098 sub moditem {
2099     my ($dbh, $item) = @_;
2100     #my $dbh = C4::Context->dbh;
2101     &REALmoditem( $dbh, $item );
2102     my $MARCitem =
2103       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
2104     my $bibid =
2105       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
2106     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
2107 }
2108
2109 =head2 checkitems
2110
2111 $error = checkitems($count,@barcodes);
2112
2113 =over 4
2114
2115 check for each @barcode entry that the barcode is not a duplicate
2116
2117 =back
2118
2119 =cut
2120
2121 sub checkitems {
2122     my ( $count, @barcodes ) = @_;
2123     my $dbh = C4::Context->dbh;
2124     my $error;
2125     my $sth = $dbh->prepare("Select * from items where barcode=?");
2126     for ( my $i = 0 ; $i < $count ; $i++ ) {
2127         $barcodes[$i] = uc $barcodes[$i];
2128         $sth->execute( $barcodes[$i] );
2129         if ( my $data = $sth->fetchrow_hashref ) {
2130             $error .= " Duplicate Barcode: $barcodes[$i]";
2131         }
2132     }
2133     $sth->finish;
2134     return ($error);
2135 }
2136
2137 =head2 delitem($itemnum);
2138
2139 =over 4
2140
2141 delete item $itemnum being the item number to delete
2142
2143 =back
2144
2145 =cut
2146
2147 sub delitem {
2148     my ($itemnum) = @_;
2149     my $dbh = C4::Context->dbh;
2150     &REALdelitem( $dbh, $itemnum );
2151 }
2152
2153 =head2 deletebiblioitem($biblioitemnumber);
2154
2155 =over 4
2156
2157 delete the biblioitem $biblioitemnumber
2158
2159 =back
2160
2161 =cut
2162
2163 sub deletebiblioitem {
2164     my ($biblioitemnumber) = @_;
2165     my $dbh = C4::Context->dbh;
2166     &REALdelbiblioitem( $dbh, $biblioitemnumber );
2167 }    # sub deletebiblioitem
2168
2169 =head2 delbiblio($biblionumber)
2170
2171 =over 4
2172
2173 delete biblio $biblionumber
2174
2175 =back
2176
2177 =cut
2178
2179 sub delbiblio {
2180     my ($biblio) = @_;
2181     my $dbh = C4::Context->dbh;
2182     &REALdelbiblio( $dbh, $biblio );
2183     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
2184     &MARCdelbiblio( $dbh, $bibid, 0 );
2185 }
2186
2187 =head2 getbiblio
2188
2189 ($count,@results) = getbiblio($biblionumber);
2190
2191 =over 4
2192
2193 return an array with hash of biblios.
2194
2195 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
2196
2197 =back
2198
2199 =cut
2200
2201 sub getbiblio {
2202     my ($biblionumber) = @_;
2203     my $dbh = C4::Context->dbh;
2204     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
2205
2206     # || die "Cannot prepare $query\n" . $dbh->errstr;
2207     my $count = 0;
2208     my @results;
2209
2210     $sth->execute($biblionumber);
2211
2212     # || die "Cannot execute $query\n" . $sth->errstr;
2213     while ( my $data = $sth->fetchrow_hashref ) {
2214         $results[$count] = $data;
2215         $count++;
2216     }    # while
2217
2218     $sth->finish;
2219     return ( $count, @results );
2220 }    # sub getbiblio
2221
2222 =head2 bibdata
2223
2224   $data = &bibdata($biblionumber, $type);
2225
2226 Returns information about the book with the given biblionumber.
2227
2228 C<$type> is ignored.
2229
2230 C<&bibdata> returns a reference-to-hash. The keys are the fields in
2231 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
2232 Koha database.
2233
2234 In addition, C<$data-E<gt>{subject}> is the list of the book's
2235 subjects, separated by C<" , "> (space, comma, space).
2236
2237 If there are multiple biblioitems with the given biblionumber, only
2238 the first one is considered.
2239
2240 =cut
2241 #'
2242 sub bibdata {
2243         my ($bibnum, $type) = @_;
2244         my $dbh   = C4::Context->dbh;
2245         my $sth   = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
2246                                                                 from biblio
2247                                                                 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
2248                                                                 left join bibliosubtitle on
2249                                                                 biblio.biblionumber = bibliosubtitle.biblionumber
2250                                                                 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
2251                                                                 where biblio.biblionumber = ?
2252                                                                 ");
2253         $sth->execute($bibnum);
2254         my $data;
2255         $data  = $sth->fetchrow_hashref;
2256         $sth->finish;
2257         # handle management of repeated subtitle
2258         $sth   = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
2259         $sth->execute($bibnum);
2260         my @subtitles;
2261         while (my $dat = $sth->fetchrow_hashref){
2262                 my %line;
2263                 $line{subtitle} = $dat->{subtitle};
2264                 push @subtitles, \%line;
2265         } # while
2266         $data->{subtitles} = \@subtitles;
2267         $sth->finish;
2268         $sth   = $dbh->prepare("SELECT * FROM bibliosubject
2269                                 WHERE subject != ''
2270                                 AND biblionumber = ?");
2271         $sth->execute($bibnum);
2272         my @subjects;
2273         while (my $dat = $sth->fetchrow_hashref){
2274                 my %line;
2275                 $line{subject} = $dat->{'subject'};
2276                 push @subjects, \%line;
2277         } # while
2278         $data->{subjects} = \@subjects;
2279         $sth->finish;
2280         $sth   = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
2281         $sth->execute($bibnum);
2282         while (my $dat = $sth->fetchrow_hashref){
2283                 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
2284         } # while
2285         chop $data->{'additionalauthors'};
2286         chop $data->{'additionalauthors'};
2287         chop $data->{'additionalauthors'};
2288         $sth->finish;
2289         return($data);
2290 } # sub bibdata
2291
2292 =head2 getbiblioitem
2293
2294 ($count,@results) = getbiblioitem($biblioitemnumber);
2295
2296 =over 4
2297
2298 return an array with hash of biblioitemss.
2299
2300 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
2301
2302 =back
2303
2304 =cut
2305
2306 sub getbiblioitem {
2307     my ($biblioitemnum) = @_;
2308     my $dbh = C4::Context->dbh;
2309     my $sth = $dbh->prepare( "Select * from biblioitems where
2310 biblioitemnumber = ?"
2311     );
2312     my $count = 0;
2313     my @results;
2314
2315     $sth->execute($biblioitemnum);
2316
2317     while ( my $data = $sth->fetchrow_hashref ) {
2318         $results[$count] = $data;
2319         $count++;
2320     }    # while
2321
2322     $sth->finish;
2323     return ( $count, @results );
2324 }    # sub getbiblioitem
2325
2326 =head2 GetBiblioItemByBiblioNumber
2327
2328 @results= GetBiblioItemByBiblioNumber($biblionumber);
2329
2330 =over 4
2331
2332 return an array with hash of biblioitems for the given biblionumber.
2333
2334 =back
2335
2336 =cut
2337
2338 sub GetBiblioItemByBiblioNumber {
2339     my ($biblionumber) = @_;
2340     my $dbh = C4::Context->dbh;
2341     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2342     my $count = 0;
2343     my @results;
2344
2345     $sth->execute($biblionumber);
2346
2347     while ( my $data = $sth->fetchrow_hashref ) {
2348         push @results, $data;
2349     }
2350
2351     $sth->finish;
2352     return @results;
2353 }    # sub
2354
2355 =head2 getitemsbybiblioitem
2356
2357 ($count,@results) = getitemsbybiblioitem($biblionumber);
2358
2359 =over 4
2360
2361 returns an array with hash of items
2362
2363 =back
2364
2365 =cut
2366
2367 sub getitemsbybiblioitem {
2368     my ($biblioitemnum) = @_;
2369     my $dbh = C4::Context->dbh;
2370     my $sth = $dbh->prepare( "Select * from items, biblio where
2371 biblio.biblionumber = items.biblionumber and biblioitemnumber
2372 = ?"
2373     );
2374
2375     # || die "Cannot prepare $query\n" . $dbh->errstr;
2376     my $count = 0;
2377     my @results;
2378
2379     $sth->execute($biblioitemnum);
2380
2381     # || die "Cannot execute $query\n" . $sth->errstr;
2382     while ( my $data = $sth->fetchrow_hashref ) {
2383         $results[$count] = $data;
2384         $count++;
2385     }    # while
2386
2387     $sth->finish;
2388     return ( $count, @results );
2389 }    # sub getitemsbybiblioitem
2390
2391 =head2 ItemInfo
2392
2393   @results = &ItemInfo($env, $biblionumber, $type);
2394
2395 Returns information about books with the given biblionumber.
2396
2397 C<$type> may be either C<intra> or anything else. If it is not set to
2398 C<intra>, then the search will exclude lost, very overdue, and
2399 withdrawn items.
2400
2401 C<$env> is ignored.
2402
2403 C<&ItemInfo> returns a list of references-to-hash. Each element
2404 contains a number of keys. Most of them are table items from the
2405 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2406 Koha database. Other keys include:
2407
2408 =over 4
2409
2410 =item C<$data-E<gt>{branchname}>
2411
2412 The name (not the code) of the branch to which the book belongs.
2413
2414 =item C<$data-E<gt>{datelastseen}>
2415
2416 This is simply C<items.datelastseen>, except that while the date is
2417 stored in YYYY-MM-DD format in the database, here it is converted to
2418 DD/MM/YYYY format. A NULL date is returned as C<//>.
2419
2420 =item C<$data-E<gt>{datedue}>
2421
2422 =item C<$data-E<gt>{class}>
2423
2424 This is the concatenation of C<biblioitems.classification>, the book's
2425 Dewey code, and C<biblioitems.subclass>.
2426
2427 =item C<$data-E<gt>{ocount}>
2428
2429 I think this is the number of copies of the book available.
2430
2431 =item C<$data-E<gt>{order}>
2432
2433 If this is set, it is set to C<One Order>.
2434
2435 =back
2436
2437 =cut
2438 #'
2439 sub ItemInfo {
2440         my ($env,$biblionumber,$type) = @_;
2441         my $dbh   = C4::Context->dbh;
2442         my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2443                                         left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2444                                         WHERE items.biblionumber = ?
2445                                         AND biblioitems.biblioitemnumber = items.biblioitemnumber
2446                                         AND biblio.biblionumber = items.biblionumber";
2447         $query .= " order by items.dateaccessioned desc";
2448         my $sth=$dbh->prepare($query);
2449         $sth->execute($biblionumber);
2450         my $i=0;
2451         my @results;
2452         while (my $data=$sth->fetchrow_hashref){
2453                 my $datedue = '';
2454                 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2455                 $isth->execute($data->{'itemnumber'});
2456                 if (my $idata=$isth->fetchrow_hashref){
2457                 $data->{borrowernumber} = $idata->{borrowernumber};
2458                 $data->{cardnumber} = $idata->{cardnumber};
2459                 $datedue = format_date($idata->{'date_due'});
2460                 }
2461                 if ($datedue eq ''){
2462                         my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2463                         if ($restype) {
2464                                 $datedue=$restype;
2465                         }
2466                 }
2467                 $isth->finish;
2468         #get branch information.....
2469                 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2470                 $bsth->execute($data->{'holdingbranch'});
2471                 if (my $bdata=$bsth->fetchrow_hashref){
2472                         $data->{'branchname'} = $bdata->{'branchname'};
2473                 }
2474                 my $date=format_date($data->{'datelastseen'});
2475                 $data->{'datelastseen'}=$date;
2476                 $data->{'datedue'}=$datedue;
2477         # get notforloan complete status if applicable
2478                 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2479                 $sthnflstatus->execute;
2480                 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2481                 if ($authorised_valuecode) {
2482                         $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2483                         $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2484                         my ($lib) = $sthnflstatus->fetchrow;
2485                         $data->{notforloan} = $lib;
2486                 }
2487                 $results[$i]=$data;
2488                 $i++;
2489         }
2490         $sth->finish;
2491         return(@results);
2492 }
2493
2494 =head2 bibitems
2495
2496   ($count, @results) = &bibitems($biblionumber);
2497
2498 Given the biblionumber for a book, C<&bibitems> looks up that book's
2499 biblioitems (different publications of the same book, the audio book
2500 and film versions, etc.).
2501
2502 C<$count> is the number of elements in C<@results>.
2503
2504 C<@results> is an array of references-to-hash; the keys are the fields
2505 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2506 addition, C<itemlost> indicates the availability of the item: if it is
2507 "2", then all copies of the item are long overdue; if it is "1", then
2508 all copies are lost; otherwise, there is at least one copy available.
2509
2510 =cut
2511 #'
2512 sub bibitems {
2513     my ($bibnum) = @_;
2514
2515     my $dbh   = C4::Context->dbh;
2516     my $sth   = $dbh->prepare("SELECT biblioitems.*,
2517                         itemtypes.*,
2518                         MIN(items.itemlost)        as itemlost,
2519                         MIN(items.dateaccessioned) as dateaccessioned
2520                           FROM biblioitems, itemtypes, items
2521                          WHERE biblioitems.biblionumber     = ?
2522                            AND biblioitems.itemtype         = itemtypes.itemtype
2523                            AND biblioitems.biblioitemnumber = items.biblioitemnumber
2524                       GROUP BY items.biblioitemnumber");
2525     my $count = 0;
2526     my @results;
2527     $sth->execute($bibnum);
2528     while (my $data = $sth->fetchrow_hashref) {
2529         $results[$count] = $data;
2530         $count++;
2531     } # while
2532     $sth->finish;
2533     return($count, @results);
2534 } # sub bibitems
2535
2536
2537 =head2 bibitemdata
2538
2539   $itemdata = &bibitemdata($biblioitemnumber);
2540
2541 Looks up the biblioitem with the given biblioitemnumber. Returns a
2542 reference-to-hash. The keys are the fields from the C<biblio>,
2543 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2544 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2545
2546 =cut
2547 #'
2548 sub bibitemdata {
2549     my ($bibitem) = @_;
2550     my $dbh   = C4::Context->dbh;
2551     my $sth   = $dbh->prepare("Select *,biblioitems.notes as bnotes from biblio, biblioitems,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype");
2552     my $data;
2553
2554     $sth->execute($bibitem);
2555
2556     $data = $sth->fetchrow_hashref;
2557
2558     $sth->finish;
2559     return($data);
2560 } # sub bibitemdata
2561
2562
2563 =head2 getbibliofromitemnumber
2564
2565   $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2566
2567 Looks up the item with the given itemnumber.
2568
2569 C<$env> and C<$dbh> are ignored.
2570
2571 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2572 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2573 database.
2574
2575 =cut
2576 #'
2577 sub getbibliofromitemnumber {
2578   my ($env,$dbh,$itemnumber) = @_;
2579   $dbh = C4::Context->dbh;
2580   my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2581     where items.itemnumber = ?
2582     and biblio.biblionumber = items.biblionumber
2583     and biblioitems.biblioitemnumber = items.biblioitemnumber");
2584 #  print $query;
2585   $sth->execute($itemnumber);
2586   my $data=$sth->fetchrow_hashref;
2587   $sth->finish;
2588   return($data);
2589 }
2590
2591 =head2 barcodes
2592
2593   @barcodes = &barcodes($biblioitemnumber);
2594
2595 Given a biblioitemnumber, looks up the corresponding items.
2596
2597 Returns an array of references-to-hash; the keys are C<barcode> and
2598 C<itemlost>.
2599
2600 The returned items include very overdue items, but not lost ones.
2601
2602 =cut
2603 #'
2604 sub barcodes{
2605     #called from request.pl
2606     my ($biblioitemnumber)=@_;
2607     my $dbh = C4::Context->dbh;
2608     my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2609                            WHERE biblioitemnumber = ?
2610                              AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2611     $sth->execute($biblioitemnumber);
2612     my @barcodes;
2613     my $i=0;
2614     while (my $data=$sth->fetchrow_hashref){
2615         $barcodes[$i]=$data;
2616         $i++;
2617     }
2618     $sth->finish;
2619     return(@barcodes);
2620 }
2621
2622
2623 =head2 itemdata
2624
2625   $item = &itemdata($barcode);
2626
2627 Looks up the item with the given barcode, and returns a
2628 reference-to-hash containing information about that item. The keys of
2629 the hash are the fields from the C<items> and C<biblioitems> tables in
2630 the Koha database.
2631
2632 =cut
2633 #'
2634 sub get_item_from_barcode {
2635   my ($barcode)=@_;
2636   my $dbh = C4::Context->dbh;
2637   my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2638   and items.biblioitemnumber=biblioitems.biblioitemnumber");
2639   $sth->execute($barcode);
2640   my $data=$sth->fetchrow_hashref;
2641   $sth->finish;
2642   return($data);
2643 }
2644
2645
2646 =head2 itemissues
2647
2648   @issues = &itemissues($biblioitemnumber, $biblio);
2649
2650 Looks up information about who has borrowed the bookZ<>(s) with the
2651 given biblioitemnumber.
2652
2653 C<$biblio> is ignored.
2654
2655 C<&itemissues> returns an array of references-to-hash. The keys
2656 include the fields from the C<items> table in the Koha database.
2657 Additional keys include:
2658
2659 =over 4
2660
2661 =item C<date_due>
2662
2663 If the item is currently on loan, this gives the due date.
2664
2665 If the item is not on loan, then this is either "Available" or
2666 "Cancelled", if the item has been withdrawn.
2667
2668 =item C<card>
2669
2670 If the item is currently on loan, this gives the card number of the
2671 patron who currently has the item.
2672
2673 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2674
2675 These give the timestamp for the last three times the item was
2676 borrowed.
2677
2678 =item C<card0>, C<card1>, C<card2>
2679
2680 The card number of the last three patrons who borrowed this item.
2681
2682 =item C<borrower0>, C<borrower1>, C<borrower2>
2683
2684 The borrower number of the last three patrons who borrowed this item.
2685
2686 =back
2687
2688 =cut
2689 #'
2690 sub itemissues {
2691     my ($bibitem, $biblio)=@_;
2692     my $dbh   = C4::Context->dbh;
2693     # FIXME - If this function die()s, the script will abort, and the
2694     # user won't get anything; depending on how far the script has
2695     # gotten, the user might get a blank page. It would be much better
2696     # to at least print an error message. The easiest way to do this
2697     # is to set $SIG{__DIE__}.
2698     my $sth   = $dbh->prepare("Select * from items where
2699 items.biblioitemnumber = ?")
2700       || die $dbh->errstr;
2701     my $i     = 0;
2702     my @results;
2703
2704     $sth->execute($bibitem)
2705       || die $sth->errstr;
2706
2707     while (my $data = $sth->fetchrow_hashref) {
2708         # Find out who currently has this item.
2709         # FIXME - Wouldn't it be better to do this as a left join of
2710         # some sort? Currently, this code assumes that if
2711         # fetchrow_hashref() fails, then the book is on the shelf.
2712         # fetchrow_hashref() can fail for any number of reasons (e.g.,
2713         # database server crash), not just because no items match the
2714         # search criteria.
2715         my $sth2   = $dbh->prepare("select * from issues,borrowers
2716 where itemnumber = ?
2717 and returndate is NULL
2718 and issues.borrowernumber = borrowers.borrowernumber");
2719
2720         $sth2->execute($data->{'itemnumber'});
2721         if (my $data2 = $sth2->fetchrow_hashref) {
2722             $data->{'date_due'} = $data2->{'date_due'};
2723             $data->{'card'}     = $data2->{'cardnumber'};
2724             $data->{'borrower'}     = $data2->{'borrowernumber'};
2725         } else {
2726             if ($data->{'wthdrawn'} eq '1') {
2727                 $data->{'date_due'} = 'Cancelled';
2728             } else {
2729                 $data->{'date_due'} = 'Available';
2730             } # else
2731         } # else
2732
2733         $sth2->finish;
2734
2735         # Find the last 3 people who borrowed this item.
2736         $sth2 = $dbh->prepare("select * from issues, borrowers
2737                                                 where itemnumber = ?
2738                                                                         and issues.borrowernumber = borrowers.borrowernumber
2739                                                                         and returndate is not NULL
2740                                                                         order by returndate desc,timestamp desc") || die $dbh->errstr;
2741         $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2742         for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2743             if (my $data2 = $sth2->fetchrow_hashref) {
2744                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2745                 $data->{"card$i2"}      = $data2->{'cardnumber'};
2746                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
2747             } # if
2748         } # for
2749
2750         $sth2->finish;
2751         $results[$i] = $data;
2752         $i++;
2753     }
2754
2755     $sth->finish;
2756     return(@results);
2757 }
2758
2759 =head2 getsubject
2760
2761   ($count, $subjects) = &getsubject($biblionumber);
2762
2763 Looks up the subjects of the book with the given biblionumber. Returns
2764 a two-element list. C<$subjects> is a reference-to-array, where each
2765 element is a subject of the book, and C<$count> is the number of
2766 elements in C<$subjects>.
2767
2768 =cut
2769 #'
2770 sub getsubject {
2771   my ($bibnum)=@_;
2772   my $dbh = C4::Context->dbh;
2773   my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2774   $sth->execute($bibnum);
2775   my @results;
2776   my $i=0;
2777   while (my $data=$sth->fetchrow_hashref){
2778     $results[$i]=$data;
2779     $i++;
2780   }
2781   $sth->finish;
2782   return($i,\@results);
2783 }
2784
2785 =head2 getaddauthor
2786
2787   ($count, $authors) = &getaddauthor($biblionumber);
2788
2789 Looks up the additional authors for the book with the given
2790 biblionumber.
2791
2792 Returns a two-element list. C<$authors> is a reference-to-array, where
2793 each element is an additional author, and C<$count> is the number of
2794 elements in C<$authors>.
2795
2796 =cut
2797 #'
2798 sub getaddauthor {
2799   my ($bibnum)=@_;
2800   my $dbh = C4::Context->dbh;
2801   my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2802   $sth->execute($bibnum);
2803   my @results;
2804   my $i=0;
2805   while (my $data=$sth->fetchrow_hashref){
2806     $results[$i]=$data;
2807     $i++;
2808   }
2809   $sth->finish;
2810   return($i,\@results);
2811 }
2812
2813
2814 =head2 getsubtitle
2815
2816   ($count, $subtitles) = &getsubtitle($biblionumber);
2817
2818 Looks up the subtitles for the book with the given biblionumber.
2819
2820 Returns a two-element list. C<$subtitles> is a reference-to-array,
2821 where each element is a subtitle, and C<$count> is the number of
2822 elements in C<$subtitles>.
2823
2824 =cut
2825 #'
2826 sub getsubtitle {
2827   my ($bibnum)=@_;
2828   my $dbh = C4::Context->dbh;
2829   my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2830   $sth->execute($bibnum);
2831   my @results;
2832   my $i=0;
2833   while (my $data=$sth->fetchrow_hashref){
2834     $results[$i]=$data;
2835     $i++;
2836   }
2837   $sth->finish;
2838   return($i,\@results);
2839 }
2840
2841
2842 =head2 getwebsites
2843
2844   ($count, @websites) = &getwebsites($biblionumber);
2845
2846 Looks up the web sites pertaining to the book with the given
2847 biblionumber.
2848
2849 C<$count> is the number of elements in C<@websites>.
2850
2851 C<@websites> is an array of references-to-hash; the keys are the
2852 fields from the C<websites> table in the Koha database.
2853
2854 =cut
2855 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2856 #(with add / modify / delete subs)
2857
2858 sub getwebsites {
2859     my ($biblionumber) = @_;
2860     my $dbh   = C4::Context->dbh;
2861     my $sth   = $dbh->prepare("Select * from websites where biblionumber = ?");
2862     my $count = 0;
2863     my @results;
2864
2865     $sth->execute($biblionumber);
2866     while (my $data = $sth->fetchrow_hashref) {
2867         # FIXME - The URL scheme shouldn't be stripped off, at least
2868         # not here, since it's part of the URL, and will be useful in
2869         # constructing a link to the site. If you don't want the user
2870         # to see the "http://" part, strip that off when building the
2871         # HTML code.
2872         $data->{'url'} =~ s/^http:\/\///;       # FIXME - Leaning toothpick
2873                                                 # syndrome
2874         $results[$count] = $data;
2875         $count++;
2876     } # while
2877
2878     $sth->finish;
2879     return($count, @results);
2880 } # sub getwebsites
2881
2882 =head2 getwebbiblioitems
2883
2884   ($count, @results) = &getwebbiblioitems($biblionumber);
2885
2886 Given a book's biblionumber, looks up the web versions of the book
2887 (biblioitems with itemtype C<WEB>).
2888
2889 C<$count> is the number of items in C<@results>. C<@results> is an
2890 array of references-to-hash; the keys are the items from the
2891 C<biblioitems> table of the Koha database.
2892
2893 =cut
2894 #'
2895 sub getwebbiblioitems {
2896     my ($biblionumber) = @_;
2897     my $dbh   = C4::Context->dbh;
2898     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2899 and itemtype = 'WEB'");
2900     my $count = 0;
2901     my @results;
2902
2903     $sth->execute($biblionumber);
2904     while (my $data = $sth->fetchrow_hashref) {
2905         $data->{'url'} =~ s/^http:\/\///;
2906         $results[$count] = $data;
2907         $count++;
2908     } # while
2909
2910     $sth->finish;
2911     return($count, @results);
2912 } # sub getwebbiblioitems
2913
2914 sub nsb_clean {
2915     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2916     my $NSE = '\x89';    # NSE : Non Sorting Block end
2917                          # handles non sorting blocks
2918     my ($string) = @_;
2919     $_ = $string;
2920     s/$NSB/(/gm;
2921     s/[ ]{0,1}$NSE/) /gm;
2922     $string = $_;
2923     return ($string);
2924 }
2925
2926 sub FindDuplicate {
2927         my ($record)=@_;
2928         my $dbh = C4::Context->dbh;
2929         my $result = MARCmarc2koha($dbh,$record,'');
2930         my $sth;
2931         my ($biblionumber,$bibid,$title);
2932         # search duplicate on ISBN, easy and fast...
2933         if ($result->{isbn}) {
2934                 $sth = $dbh->prepare("select biblio.biblionumber,bibid,title from biblio,biblioitems,marc_biblio where biblio.biblionumber=biblioitems.biblionumber and marc_biblio.biblionumber=biblioitems.biblionumber and isbn=?");
2935                 $sth->execute($result->{'isbn'});
2936                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2937                 return $biblionumber,$bibid,$title if ($biblionumber);
2938         }
2939         # a more complex search : build a request for SearchMarc::catalogsearch()
2940         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2941         # search on biblio.title
2942         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2943         if ($record->field($tag)) {
2944                 if ($record->field($tag)->subfields($subfield)) {
2945                         push @tags, "'".$tag.$subfield."'";
2946                         push @and_or, "and";
2947                         push @excluding, "";
2948                         push @operator, "contains";
2949                         push @value, $record->field($tag)->subfield($subfield);
2950 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2951                 }
2952         }
2953         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle","");
2954         if ($record->field($tag)) {
2955                 if ($record->field($tag)->subfields($subfield)) {
2956                         push @tags, "'".$tag.$subfield."'";
2957                         push @and_or, "and";
2958                         push @excluding, "";
2959                         push @operator, "contains";
2960                         push @value, $record->field($tag)->subfield($subfield);
2961 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2962                 }
2963         }
2964         # ... and on biblio.author
2965         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2966         if ($record->field($tag)) {
2967                 if ($record->field($tag)->subfields($subfield)) {
2968                         push @tags, "'".$tag.$subfield."'";
2969                         push @and_or, "and";
2970                         push @excluding, "";
2971                         push @operator, "contains";
2972                         push @value, $record->field($tag)->subfield($subfield);
2973 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2974                 }
2975         }
2976         # ... and on publicationyear.
2977         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2978         if ($record->field($tag)) {
2979                 if ($record->field($tag)->subfields($subfield)) {
2980                         push @tags, "'".$tag.$subfield."'";
2981                         push @and_or, "and";
2982                         push @excluding, "";
2983                         push @operator, "=";
2984                         push @value, $record->field($tag)->subfield($subfield);
2985 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2986                 }
2987         }
2988         # ... and on size.
2989         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2990         if ($record->field($tag)) {
2991                 if ($record->field($tag)->subfields($subfield)) {
2992                         push @tags, "'".$tag.$subfield."'";
2993                         push @and_or, "and";
2994                         push @excluding, "";
2995                         push @operator, "=";
2996                         push @value, $record->field($tag)->subfield($subfield);
2997 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2998                 }
2999         }
3000         # ... and on publisher.
3001         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
3002         if ($record->field($tag)) {
3003                 if ($record->field($tag)->subfields($subfield)) {
3004                         push @tags, "'".$tag.$subfield."'";
3005                         push @and_or, "and";
3006                         push @excluding, "";
3007                         push @operator, "=";
3008                         push @value, $record->field($tag)->subfield($subfield);
3009 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
3010                 }
3011         }
3012         # ... and on volume.
3013         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
3014         if ($record->field($tag)) {
3015                 if ($record->field($tag)->subfields($subfield)) {
3016                         push @tags, "'".$tag.$subfield."'";
3017                         push @and_or, "and";
3018                         push @excluding, "";
3019                         push @operator, "=";
3020                         push @value, $record->field($tag)->subfield($subfield);
3021 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
3022                 }
3023         }
3024
3025         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
3026         # there is at least 1 result => return the 1st one
3027         if ($nbresult) {
3028 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
3029                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
3030         }
3031         # no result, returns nothing
3032         return;
3033 }
3034
3035 sub DisplayISBN {
3036         my ($isbn)=@_;
3037         my $seg1;
3038         if(substr($isbn, 0, 1) <=7) {
3039                 $seg1 = substr($isbn, 0, 1);
3040         } elsif(substr($isbn, 0, 2) <= 94) {
3041                 $seg1 = substr($isbn, 0, 2);
3042         } elsif(substr($isbn, 0, 3) <= 995) {
3043                 $seg1 = substr($isbn, 0, 3);
3044         } elsif(substr($isbn, 0, 4) <= 9989) {
3045                 $seg1 = substr($isbn, 0, 4);
3046         } else {
3047                 $seg1 = substr($isbn, 0, 5);
3048         }
3049         my $x = substr($isbn, length($seg1));
3050         my $seg2;
3051         if(substr($x, 0, 2) <= 19) {
3052 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
3053                 $seg2 = substr($x, 0, 2);
3054         } elsif(substr($x, 0, 3) <= 699) {
3055                 $seg2 = substr($x, 0, 3);
3056         } elsif(substr($x, 0, 4) <= 8399) {
3057                 $seg2 = substr($x, 0, 4);
3058         } elsif(substr($x, 0, 5) <= 89999) {
3059                 $seg2 = substr($x, 0, 5);
3060         } elsif(substr($x, 0, 6) <= 9499999) {
3061                 $seg2 = substr($x, 0, 6);
3062         } else {
3063                 $seg2 = substr($x, 0, 7);
3064         }
3065         my $seg3=substr($x,length($seg2));
3066         $seg3=substr($seg3,0,length($seg3)-1) ;
3067         my $seg4 = substr($x, -1, 1);
3068         return "$seg1-$seg2-$seg3-$seg4";
3069 }
3070
3071 =head2 get_itemnumbers_of
3072
3073   my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
3074
3075 Given a list of biblionumbers, return the list of corresponding itemnumbers
3076 for each biblionumber.
3077
3078 Return a reference on a hash where keys are biblionumbers and values are
3079 references on array of itemnumbers.
3080
3081 =cut
3082 sub get_itemnumbers_of {
3083     my @biblionumbers = @_;
3084
3085     my $dbh = C4::Context->dbh;
3086
3087     my $query = '
3088 SELECT itemnumber,
3089        biblionumber
3090   FROM items
3091   WHERE biblionumber IN (?'.(',?' x scalar @biblionumbers - 1).')
3092 ';
3093     my $sth = $dbh->prepare($query);
3094     $sth->execute(@biblionumbers);
3095
3096     my %itemnumbers_of;
3097
3098     while (my ($itemnumber, $biblionumber) = $sth->fetchrow_array) {
3099         push @{$itemnumbers_of{$biblionumber}}, $itemnumber;
3100     }
3101
3102     return \%itemnumbers_of;
3103 }
3104
3105 sub get_iteminfos_of {
3106     my @itemnumbers = @_;
3107
3108     my $query = '
3109 SELECT *
3110   FROM items
3111   WHERE itemnumber IN ('.join(',', @itemnumbers).')
3112 ';
3113     return get_infos_of($query, 'itemnumber');
3114 }
3115
3116 sub get_biblioiteminfos_of {
3117     my @biblioitemnumbers = @_;
3118
3119     my $query = '
3120 SELECT biblioitemnumber,
3121        publicationyear,
3122        itemtype
3123   FROM biblioitems
3124   WHERE biblioitemnumber IN ('.join(',', @biblioitemnumbers).')
3125 ';
3126
3127     return get_infos_of($query, 'biblioitemnumber');
3128 }
3129
3130 END { }    # module clean-up code here (global destructor)
3131
3132 =back
3133
3134 =head1 AUTHOR
3135
3136 Koha Developement team <info@koha.org>
3137
3138 Paul POULAIN paul.poulain@free.fr
3139
3140 =cut
3141
3142 # $Id$
3143 # $Log$
3144 # Revision 1.175  2006/07/27 13:46:30  toins
3145 # 1 Sub renamed.
3146 #
3147 # Revision 1.174  2006/07/12 13:43:42  btoumi
3148 # bug fixing:
3149 # Biblio.pm: add in export line  getbibliofromitemnumber function
3150 # fines2.pl:call to biblio.pm for use of getbibliofromitemnumber function
3151 #
3152 # Revision 1.173  2006/07/04 14:36:51  toins
3153 # Head & rel_2_2 merged
3154 #
3155 # Revision 1.172  2006/06/06 23:13:14  bob_lyon
3156 # Merging katipo changes...
3157 #
3158 # altering subject search to stop returning blank rows
3159 #
3160 # Revision 1.171  2006/05/17 16:06:24  plg
3161 # New feature from SAN Ouest Provence: ability to reserve a specific item in
3162 # the intranet. The development was made on branch 2.2 by Arnaud Laurin from
3163 # Ouest Provence and integrated on HEAD by Pierrick Le Gall from INEO media
3164 # system.
3165 #
3166 # New page reserve/request.pl taking a biblionumber as entry point.
3167 #
3168 # New functions:
3169 #
3170 # - C4::Biblio::get_iteminfos_of retrieves item informations for a list of
3171 #   itemnumbers
3172 #
3173 # - C4::Biblio::get_biblioiteminfos_of retrieves biblioitem informations for a
3174 #   list of biblioitemnumbers
3175 #
3176 # - C4::Biblio::get_itemnumbers_of retrieve the list of itemnumbers related to
3177 #   each biblionumber given in argument.
3178 #
3179 # - C4::Circulation::Circ2::get_return_date_of retrieves return date for a
3180 #   list of itemnumbers.
3181 #
3182 # - C4::Koha::get_itemtypeinfos_of retrieves the informations related to a
3183 #   list of itemtypes.
3184 #
3185 # - C4::Koha::get_branchinfos_of retrieves the informations related to a list
3186 #   of branchcodes.
3187 #
3188 # - C4::Koha::get_notforloan_label_of retrives the list of status/label for
3189 #   the authorised_values related to notforloan.
3190 #
3191 # - C4::Koha::get_infos_of is the generic function used by all get_*infos_of.
3192 #
3193 # - C4::Reserves2::GetNumberReservesFromBorrower
3194 #
3195 # - C4::Reserves2::GetFirstReserveDateFromItem
3196 #
3197 # Modified functions:
3198 #
3199 # - C4::Reserves2::FindReserves was simplified to be more readable.
3200 #
3201 # The reservation page is reserve/request.pl and is linked from nowhere as
3202 # long as zebra is not stable yet on HEAD.
3203 #
3204 # Revision 1.170  2006/04/15 02:47:47  tgarip1957
3205 # Change the MARC Leader to UTF-8 incase user did not set it. Important for Zebra.
3206 # The new M::F::XML is sensitive to leader settings
3207 #
3208 # Revision 1.169  2006/04/10 20:39:49  tgarip1957
3209 # New sub to use by Circ2.pm . Allows one subfield of MARC holdings fields to be updated to use with branch transfer(holdingbranch) and onloan flag when set
3210 #
3211 # Revision 1.168  2006/04/03 04:00:02  rangi
3212 # Modify item now works
3213 #
3214 # BUT only if there is only one item, if there is more than one item, it gets messed up.
3215 # They get combined into the form, ill work on this next
3216 #
3217 # Revision 1.167  2006/04/03 02:12:49  kados
3218 # some modifs to improve plugin support
3219 #
3220 # Revision 1.166  2006/04/01 22:10:50  rangi
3221 # Fixing the problem that all items were getting biblioitem=1 set
3222 #
3223 # Revision 1.165  2006/04/01 21:22:05  rangi
3224 # Adding a little fake subroutine that a few scripts in the opac depend on, can be removed once the opac scripts are rewritten
3225 #
3226 # Revision 1.164  2006/03/29 01:56:25  rangi
3227 # Delete isnt working using the extended services method
3228 #
3229 # Revision 1.163  2006/03/28 23:05:08  rangi
3230 # Delete working now
3231 #
3232 # Revision 1.162  2006/03/13 23:12:44  rangi
3233 # Adding commits, so that changes stick
3234 #
3235 # Revision 1.161  2006/03/10 02:40:38  kados
3236 # syncing MARChtml2xml wtih rel_2_2, removing unused MARChtml2marc
3237 #
3238 # Revision 1.160  2006/03/07 22:00:18  kados
3239 # adding support for 'delete' function
3240 #
3241 # Revision 1.159  2006/03/07 21:54:47  rangi
3242 # Starting work on deletes
3243 #
3244 # Revision 1.158  2006/03/06 02:45:41  kados
3245 # Adding fixes to MARC editor to HEAD
3246 #
3247 # Revision 1.157  2006/03/01 03:07:54  kados
3248 # rollback ... by accident I committed a rel_2_2 Biblio.pm
3249 #
3250 # Revision 1.155  2006/02/27 01:08:31  kados
3251 # Removing 'our Zconn' from top...
3252 #
3253 # Revision 1.154  2006/02/26 00:08:20  kados
3254 # moving all $Zconn s to z3950_extended_services (currently, nothing
3255 # works).
3256 #
3257 # Revision 1.153  2006/02/25 22:39:10  kados
3258 # Another purely documentation commit. Just changing formatting to ease
3259 # readability.
3260 #
3261 # Revision 1.152  2006/02/25 21:17:20  kados
3262 # Purely documentation change: converted all =head2 entries to use function
3263 # name as title rather than usage as title
3264 #
3265 # Revision 1.151  2006/02/25 21:02:20  kados
3266 #
3267 # Further cleanup, convering new routines to 4-chars
3268 #
3269 # Revision 1.150  2006/02/25 20:49:15  kados
3270 # Better documentation, added warning if serviceType is 'drop' since it's
3271 # not supported in Zebra.
3272 #
3273 # Revision 1.149  2006/02/25 20:30:32  kados
3274 # IMPORTANT: Paul, I've removed the decode_char routine because it's no
3275 # longer necessary. If we need to convert from MARC-8 for display, we should:
3276 #
3277 # 1. use utf-8
3278 # 2. do it with MARC::Charset
3279 #
3280 # If you still need it, let me know and I'll put it back in.
3281 #
3282 # Revision 1.148  2006/02/25 19:23:01  kados
3283 # cleaning up POD docs, deleting zebra_create as it's no longer used (
3284 # replaced by z3950_extended_services).
3285 #
3286 # Revision 1.147  2006/02/25 19:09:59  kados
3287 # readding some lost subs
3288 #
3289 # Revision 1.145  2006/02/22 01:02:39  kados
3290 # Replacing all calls to zebra_update with calls to
3291 # z3950_extended_services. More work coming, but it's
3292 # working now.
3293 #
3294 # Revision 1.144  2006/02/20 14:22:38  kados
3295 # typo
3296 #
3297 # Revision 1.143  2006/02/20 13:26:11  kados
3298 # A new subroutine to handle Z39.50 extended services. You pass it a
3299 # connection object, service type, service options, and a record, and
3300 # it performs the service and handles any exception found.
3301 #
3302 # Revision 1.142  2006/02/16 20:49:56  kados
3303 # destroy a connection after we're done -- we really should just have one
3304 # connection object and not destroy it until the whole transaction is
3305 # finished -- but this will do for now
3306 #
3307 # Revision 1.141  2006/02/16 19:47:22  rangi
3308 # Trying to error trap a little more.
3309 #
3310 # Revision 1.140  2006/02/14 21:36:03  kados
3311 # adding a 'use ZOOM' to biblio.pm, needed for non-mod_perl install.
3312 # also adding diagnostic error if not able to connect to Zebra
3313 #
3314 # Revision 1.139  2006/02/14 19:53:25  rangi
3315 # Just a little missing my
3316 #
3317 # Seems to be working great Paul, and I like what you did with zebradb
3318 #
3319 # Revision 1.138  2006/02/14 11:25:22  tipaul
3320 # road to 3.0 : updating a biblio in zebra seems to work. Still working on it, there are probably some bugs !
3321 #
3322 # Revision 1.137  2006/02/13 16:34:26  tipaul
3323 # fixing some warnings (perl -w should be quiet)
3324 #
3325 # Revision 1.136  2006/01/10 17:01:29  tipaul
3326 # adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
3327 #
3328 # Revision 1.135  2006/01/06 16:39:37  tipaul
3329 # synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
3330 # Seems not to break too many things, but i'm probably wrong here.
3331 # at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
3332 #
3333 # - removing useless directories (koha-html and koha-plucene)
3334 #
3335 # Revision 1.134  2006/01/04 15:54:55  tipaul
3336 # utf8 is a : go for beta test in HEAD.
3337 # some explanations :
3338 # - updater/updatedatabase => will transform all tables in innoDB (not related to utf8, just to warn you) AND collate them in utf8 / utf8_general_ci. The SQL command is : ALTER TABLE tablename DEFAULT CHARACTER SET utf8 COLLATE utf8_general_ci.
3339 # - *-top.inc will show the pages in utf8
3340 # - THE HARD THING : for me, mysql-client and mysql-server were set up to communicate in iso8859-1, whatever the mysql collation ! Thus, pages were improperly shown, as datas were transmitted in iso8859-1 format ! After a full day of investigation, someone on usenet pointed "set NAMES 'utf8'" to explain that I wanted utf8. I could put this in my.cnf, but if I do that, ALL databases will "speak" in utf8, that's not what we want. Thus, I added a line in Context.pm : everytime a DB handle is opened, the communication is set to utf8.
3341 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
3342 #
3343 # Revision 1.133  2005/12/12 14:25:51  thd
3344 #
3345 #
3346 # Reverse array filled with elements from repeated subfields
3347 # to avoid last to first concatenation of elements in Koha DB.-
3348 #
3349 # Revision 1.132  2005-10-26 09:12:33  tipaul
3350 # big commit, still breaking things...
3351 #
3352 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
3353 # * code cleaning (cleaning warnings from perl -w) continued
3354 #
3355 # Revision 1.131  2005/09/22 10:01:45  tipaul
3356 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
3357 #
3358 # Revision 1.130  2005/09/02 14:34:14  tipaul
3359 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
3360 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
3361 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
3362 #
3363 # Revision 1.129  2005/08/12 13:50:31  tipaul
3364 # removing useless sub declarations
3365 #
3366 # Revision 1.128  2005/08/11 16:12:47  tipaul
3367 # Playing with the zebra...
3368 #
3369 # * go to koha cvs home directory
3370 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
3371 # * put your zebra.cfg files here & create your database.
3372 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
3373 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
3374 #
3375 # NOTE :
3376 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
3377 # * deletion still not work
3378 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
3379 # in zebra.cfg :
3380 # recordId: (bib1,Local-number)
3381 # storeKeys:1
3382 #
3383 # in .abs file :
3384 # elm 090            Local-number            -
3385 # elm 090/?          Local-number            -
3386 # elm 090/?/9        Local-number            !:w
3387 #
3388 # (090$9 being the field mapped to biblio.biblionumber in Koha)
3389 #
3390 # Revision 1.127  2005/08/11 14:37:32  tipaul
3391 # * POD documenting
3392 # * removing useless subs
3393 # * removing some subs that are also elsewhere
3394 # * renaming all OLDxxx subs to REALxxx subs (should not change anything, as OLDxxx, as well as REAL, are supposed to be for Biblio.pm internal use only)
3395 #
3396 # Revision 1.126  2005/08/11 09:13:28  tipaul
3397 # just removing useless subs (a lot !!!) for code cleaning
3398 #
3399 # Revision 1.125  2005/08/11 09:00:07  tipaul
3400 # Ok guys, this time, it seems that item add and modif begin working as expected...
3401 # Still a lot of bugs to fix, of course
3402 #
3403 # Revision 1.124  2005/08/10 10:21:15  tipaul
3404 # continuing the road to zebra :
3405 # - the biblio add begins to work.
3406 # - the biblio modif begins to work.
3407 #
3408 # (still without doing anything on zebra)
3409 # (no new change in updatedatabase)
3410 #
3411 # Revision 1.123  2005/08/09 14:10:28  tipaul
3412 # 1st commit to go to zebra.
3413 # don't update your cvs if you want to have a working head...
3414 #
3415 # this commit contains :
3416 # * updater/updatedatabase : get rid with marc_* tables, but DON'T remove them. As a lot of things uses them, it would not be a good idea for instance to drop them. If you really want to play, you can rename them to test head without them but being still able to reintroduce them...
3417 # * Biblio.pm : modify MARCgetbiblio to find the raw marc record in biblioitems.marc field, not from marc_subfield_table, modify MARCfindframeworkcode to find frameworkcode in biblio.frameworkcode, modify some other subs to use biblio.biblionumber & get rid of bibid.
3418 # * other files : get rid of bibid and use biblionumber instead.
3419 #
3420 # What is broken :
3421 # * does not do anything on zebra yet.
3422 # * if you rename marc_subfield_table, you can't search anymore.
3423 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
3424 # * don't try to add a biblio, it would add data poorly... (don't try to delete either, it may work, but that would be a surprise ;-) )
3425 #
3426 # IMPORTANT NOTE : you need MARC::XML package (http://search.cpan.org/~esummers/MARC-XML-0.7/lib/MARC/File/XML.pm), that requires a recent version of MARC::Record
3427 # Updatedatabase stores the iso2709 data in biblioitems.marc field & an xml version in biblioitems.marcxml Not sure we will keep it when releasing the stable version, but I think it's a good idea to have something readable in sql, at least for development stage.
3428
3429 # tipaul cutted previous commit notes