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 ($count,@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         $results[$count] = $data;
2349         $count++;
2350     }    # while
2351
2352     $sth->finish;
2353     return ( $count, @results );
2354 }    # sub
2355
2356 =head2 getitemsbybiblioitem
2357
2358 ($count,@results) = getitemsbybiblioitem($biblionumber);
2359
2360 =over 4
2361
2362 returns an array with hash of items
2363
2364 =back
2365
2366 =cut
2367
2368 sub getitemsbybiblioitem {
2369     my ($biblioitemnum) = @_;
2370     my $dbh = C4::Context->dbh;
2371     my $sth = $dbh->prepare( "Select * from items, biblio where
2372 biblio.biblionumber = items.biblionumber and biblioitemnumber
2373 = ?"
2374     );
2375
2376     # || die "Cannot prepare $query\n" . $dbh->errstr;
2377     my $count = 0;
2378     my @results;
2379
2380     $sth->execute($biblioitemnum);
2381
2382     # || die "Cannot execute $query\n" . $sth->errstr;
2383     while ( my $data = $sth->fetchrow_hashref ) {
2384         $results[$count] = $data;
2385         $count++;
2386     }    # while
2387
2388     $sth->finish;
2389     return ( $count, @results );
2390 }    # sub getitemsbybiblioitem
2391
2392 =head2 ItemInfo
2393
2394   @results = &ItemInfo($env, $biblionumber, $type);
2395
2396 Returns information about books with the given biblionumber.
2397
2398 C<$type> may be either C<intra> or anything else. If it is not set to
2399 C<intra>, then the search will exclude lost, very overdue, and
2400 withdrawn items.
2401
2402 C<$env> is ignored.
2403
2404 C<&ItemInfo> returns a list of references-to-hash. Each element
2405 contains a number of keys. Most of them are table items from the
2406 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2407 Koha database. Other keys include:
2408
2409 =over 4
2410
2411 =item C<$data-E<gt>{branchname}>
2412
2413 The name (not the code) of the branch to which the book belongs.
2414
2415 =item C<$data-E<gt>{datelastseen}>
2416
2417 This is simply C<items.datelastseen>, except that while the date is
2418 stored in YYYY-MM-DD format in the database, here it is converted to
2419 DD/MM/YYYY format. A NULL date is returned as C<//>.
2420
2421 =item C<$data-E<gt>{datedue}>
2422
2423 =item C<$data-E<gt>{class}>
2424
2425 This is the concatenation of C<biblioitems.classification>, the book's
2426 Dewey code, and C<biblioitems.subclass>.
2427
2428 =item C<$data-E<gt>{ocount}>
2429
2430 I think this is the number of copies of the book available.
2431
2432 =item C<$data-E<gt>{order}>
2433
2434 If this is set, it is set to C<One Order>.
2435
2436 =back
2437
2438 =cut
2439 #'
2440 sub ItemInfo {
2441         my ($env,$biblionumber,$type) = @_;
2442         my $dbh   = C4::Context->dbh;
2443         my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2444                                         left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2445                                         WHERE items.biblionumber = ?
2446                                         AND biblioitems.biblioitemnumber = items.biblioitemnumber
2447                                         AND biblio.biblionumber = items.biblionumber";
2448         $query .= " order by items.dateaccessioned desc";
2449         my $sth=$dbh->prepare($query);
2450         $sth->execute($biblionumber);
2451         my $i=0;
2452         my @results;
2453         while (my $data=$sth->fetchrow_hashref){
2454                 my $datedue = '';
2455                 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2456                 $isth->execute($data->{'itemnumber'});
2457                 if (my $idata=$isth->fetchrow_hashref){
2458                 $data->{borrowernumber} = $idata->{borrowernumber};
2459                 $data->{cardnumber} = $idata->{cardnumber};
2460                 $datedue = format_date($idata->{'date_due'});
2461                 }
2462                 if ($datedue eq ''){
2463                         my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2464                         if ($restype) {
2465                                 $datedue=$restype;
2466                         }
2467                 }
2468                 $isth->finish;
2469         #get branch information.....
2470                 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2471                 $bsth->execute($data->{'holdingbranch'});
2472                 if (my $bdata=$bsth->fetchrow_hashref){
2473                         $data->{'branchname'} = $bdata->{'branchname'};
2474                 }
2475                 my $date=format_date($data->{'datelastseen'});
2476                 $data->{'datelastseen'}=$date;
2477                 $data->{'datedue'}=$datedue;
2478         # get notforloan complete status if applicable
2479                 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2480                 $sthnflstatus->execute;
2481                 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2482                 if ($authorised_valuecode) {
2483                         $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2484                         $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2485                         my ($lib) = $sthnflstatus->fetchrow;
2486                         $data->{notforloan} = $lib;
2487                 }
2488                 $results[$i]=$data;
2489                 $i++;
2490         }
2491         $sth->finish;
2492         return(@results);
2493 }
2494
2495 =head2 bibitems
2496
2497   ($count, @results) = &bibitems($biblionumber);
2498
2499 Given the biblionumber for a book, C<&bibitems> looks up that book's
2500 biblioitems (different publications of the same book, the audio book
2501 and film versions, etc.).
2502
2503 C<$count> is the number of elements in C<@results>.
2504
2505 C<@results> is an array of references-to-hash; the keys are the fields
2506 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2507 addition, C<itemlost> indicates the availability of the item: if it is
2508 "2", then all copies of the item are long overdue; if it is "1", then
2509 all copies are lost; otherwise, there is at least one copy available.
2510
2511 =cut
2512 #'
2513 sub bibitems {
2514     my ($bibnum) = @_;
2515
2516     my $dbh   = C4::Context->dbh;
2517     my $sth   = $dbh->prepare("SELECT biblioitems.*,
2518                         itemtypes.*,
2519                         MIN(items.itemlost)        as itemlost,
2520                         MIN(items.dateaccessioned) as dateaccessioned
2521                           FROM biblioitems, itemtypes, items
2522                          WHERE biblioitems.biblionumber     = ?
2523                            AND biblioitems.itemtype         = itemtypes.itemtype
2524                            AND biblioitems.biblioitemnumber = items.biblioitemnumber
2525                       GROUP BY items.biblioitemnumber");
2526     my $count = 0;
2527     my @results;
2528     $sth->execute($bibnum);
2529     while (my $data = $sth->fetchrow_hashref) {
2530         $results[$count] = $data;
2531         $count++;
2532     } # while
2533     $sth->finish;
2534     return($count, @results);
2535 } # sub bibitems
2536
2537
2538 =head2 bibitemdata
2539
2540   $itemdata = &bibitemdata($biblioitemnumber);
2541
2542 Looks up the biblioitem with the given biblioitemnumber. Returns a
2543 reference-to-hash. The keys are the fields from the C<biblio>,
2544 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2545 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2546
2547 =cut
2548 #'
2549 sub bibitemdata {
2550     my ($bibitem) = @_;
2551     my $dbh   = C4::Context->dbh;
2552     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");
2553     my $data;
2554
2555     $sth->execute($bibitem);
2556
2557     $data = $sth->fetchrow_hashref;
2558
2559     $sth->finish;
2560     return($data);
2561 } # sub bibitemdata
2562
2563
2564 =head2 getbibliofromitemnumber
2565
2566   $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2567
2568 Looks up the item with the given itemnumber.
2569
2570 C<$env> and C<$dbh> are ignored.
2571
2572 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2573 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2574 database.
2575
2576 =cut
2577 #'
2578 sub getbibliofromitemnumber {
2579   my ($env,$dbh,$itemnumber) = @_;
2580   $dbh = C4::Context->dbh;
2581   my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2582     where items.itemnumber = ?
2583     and biblio.biblionumber = items.biblionumber
2584     and biblioitems.biblioitemnumber = items.biblioitemnumber");
2585 #  print $query;
2586   $sth->execute($itemnumber);
2587   my $data=$sth->fetchrow_hashref;
2588   $sth->finish;
2589   return($data);
2590 }
2591
2592 =head2 barcodes
2593
2594   @barcodes = &barcodes($biblioitemnumber);
2595
2596 Given a biblioitemnumber, looks up the corresponding items.
2597
2598 Returns an array of references-to-hash; the keys are C<barcode> and
2599 C<itemlost>.
2600
2601 The returned items include very overdue items, but not lost ones.
2602
2603 =cut
2604 #'
2605 sub barcodes{
2606     #called from request.pl
2607     my ($biblioitemnumber)=@_;
2608     my $dbh = C4::Context->dbh;
2609     my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2610                            WHERE biblioitemnumber = ?
2611                              AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2612     $sth->execute($biblioitemnumber);
2613     my @barcodes;
2614     my $i=0;
2615     while (my $data=$sth->fetchrow_hashref){
2616         $barcodes[$i]=$data;
2617         $i++;
2618     }
2619     $sth->finish;
2620     return(@barcodes);
2621 }
2622
2623
2624 =head2 itemdata
2625
2626   $item = &itemdata($barcode);
2627
2628 Looks up the item with the given barcode, and returns a
2629 reference-to-hash containing information about that item. The keys of
2630 the hash are the fields from the C<items> and C<biblioitems> tables in
2631 the Koha database.
2632
2633 =cut
2634 #'
2635 sub get_item_from_barcode {
2636   my ($barcode)=@_;
2637   my $dbh = C4::Context->dbh;
2638   my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2639   and items.biblioitemnumber=biblioitems.biblioitemnumber");
2640   $sth->execute($barcode);
2641   my $data=$sth->fetchrow_hashref;
2642   $sth->finish;
2643   return($data);
2644 }
2645
2646
2647 =head2 itemissues
2648
2649   @issues = &itemissues($biblioitemnumber, $biblio);
2650
2651 Looks up information about who has borrowed the bookZ<>(s) with the
2652 given biblioitemnumber.
2653
2654 C<$biblio> is ignored.
2655
2656 C<&itemissues> returns an array of references-to-hash. The keys
2657 include the fields from the C<items> table in the Koha database.
2658 Additional keys include:
2659
2660 =over 4
2661
2662 =item C<date_due>
2663
2664 If the item is currently on loan, this gives the due date.
2665
2666 If the item is not on loan, then this is either "Available" or
2667 "Cancelled", if the item has been withdrawn.
2668
2669 =item C<card>
2670
2671 If the item is currently on loan, this gives the card number of the
2672 patron who currently has the item.
2673
2674 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2675
2676 These give the timestamp for the last three times the item was
2677 borrowed.
2678
2679 =item C<card0>, C<card1>, C<card2>
2680
2681 The card number of the last three patrons who borrowed this item.
2682
2683 =item C<borrower0>, C<borrower1>, C<borrower2>
2684
2685 The borrower number of the last three patrons who borrowed this item.
2686
2687 =back
2688
2689 =cut
2690 #'
2691 sub itemissues {
2692     my ($bibitem, $biblio)=@_;
2693     my $dbh   = C4::Context->dbh;
2694     # FIXME - If this function die()s, the script will abort, and the
2695     # user won't get anything; depending on how far the script has
2696     # gotten, the user might get a blank page. It would be much better
2697     # to at least print an error message. The easiest way to do this
2698     # is to set $SIG{__DIE__}.
2699     my $sth   = $dbh->prepare("Select * from items where
2700 items.biblioitemnumber = ?")
2701       || die $dbh->errstr;
2702     my $i     = 0;
2703     my @results;
2704
2705     $sth->execute($bibitem)
2706       || die $sth->errstr;
2707
2708     while (my $data = $sth->fetchrow_hashref) {
2709         # Find out who currently has this item.
2710         # FIXME - Wouldn't it be better to do this as a left join of
2711         # some sort? Currently, this code assumes that if
2712         # fetchrow_hashref() fails, then the book is on the shelf.
2713         # fetchrow_hashref() can fail for any number of reasons (e.g.,
2714         # database server crash), not just because no items match the
2715         # search criteria.
2716         my $sth2   = $dbh->prepare("select * from issues,borrowers
2717 where itemnumber = ?
2718 and returndate is NULL
2719 and issues.borrowernumber = borrowers.borrowernumber");
2720
2721         $sth2->execute($data->{'itemnumber'});
2722         if (my $data2 = $sth2->fetchrow_hashref) {
2723             $data->{'date_due'} = $data2->{'date_due'};
2724             $data->{'card'}     = $data2->{'cardnumber'};
2725             $data->{'borrower'}     = $data2->{'borrowernumber'};
2726         } else {
2727             if ($data->{'wthdrawn'} eq '1') {
2728                 $data->{'date_due'} = 'Cancelled';
2729             } else {
2730                 $data->{'date_due'} = 'Available';
2731             } # else
2732         } # else
2733
2734         $sth2->finish;
2735
2736         # Find the last 3 people who borrowed this item.
2737         $sth2 = $dbh->prepare("select * from issues, borrowers
2738                                                 where itemnumber = ?
2739                                                                         and issues.borrowernumber = borrowers.borrowernumber
2740                                                                         and returndate is not NULL
2741                                                                         order by returndate desc,timestamp desc") || die $dbh->errstr;
2742         $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2743         for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2744             if (my $data2 = $sth2->fetchrow_hashref) {
2745                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2746                 $data->{"card$i2"}      = $data2->{'cardnumber'};
2747                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
2748             } # if
2749         } # for
2750
2751         $sth2->finish;
2752         $results[$i] = $data;
2753         $i++;
2754     }
2755
2756     $sth->finish;
2757     return(@results);
2758 }
2759
2760 =head2 getsubject
2761
2762   ($count, $subjects) = &getsubject($biblionumber);
2763
2764 Looks up the subjects of the book with the given biblionumber. Returns
2765 a two-element list. C<$subjects> is a reference-to-array, where each
2766 element is a subject of the book, and C<$count> is the number of
2767 elements in C<$subjects>.
2768
2769 =cut
2770 #'
2771 sub getsubject {
2772   my ($bibnum)=@_;
2773   my $dbh = C4::Context->dbh;
2774   my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2775   $sth->execute($bibnum);
2776   my @results;
2777   my $i=0;
2778   while (my $data=$sth->fetchrow_hashref){
2779     $results[$i]=$data;
2780     $i++;
2781   }
2782   $sth->finish;
2783   return($i,\@results);
2784 }
2785
2786 =head2 getaddauthor
2787
2788   ($count, $authors) = &getaddauthor($biblionumber);
2789
2790 Looks up the additional authors for the book with the given
2791 biblionumber.
2792
2793 Returns a two-element list. C<$authors> is a reference-to-array, where
2794 each element is an additional author, and C<$count> is the number of
2795 elements in C<$authors>.
2796
2797 =cut
2798 #'
2799 sub getaddauthor {
2800   my ($bibnum)=@_;
2801   my $dbh = C4::Context->dbh;
2802   my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2803   $sth->execute($bibnum);
2804   my @results;
2805   my $i=0;
2806   while (my $data=$sth->fetchrow_hashref){
2807     $results[$i]=$data;
2808     $i++;
2809   }
2810   $sth->finish;
2811   return($i,\@results);
2812 }
2813
2814
2815 =head2 getsubtitle
2816
2817   ($count, $subtitles) = &getsubtitle($biblionumber);
2818
2819 Looks up the subtitles for the book with the given biblionumber.
2820
2821 Returns a two-element list. C<$subtitles> is a reference-to-array,
2822 where each element is a subtitle, and C<$count> is the number of
2823 elements in C<$subtitles>.
2824
2825 =cut
2826 #'
2827 sub getsubtitle {
2828   my ($bibnum)=@_;
2829   my $dbh = C4::Context->dbh;
2830   my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2831   $sth->execute($bibnum);
2832   my @results;
2833   my $i=0;
2834   while (my $data=$sth->fetchrow_hashref){
2835     $results[$i]=$data;
2836     $i++;
2837   }
2838   $sth->finish;
2839   return($i,\@results);
2840 }
2841
2842
2843 =head2 getwebsites
2844
2845   ($count, @websites) = &getwebsites($biblionumber);
2846
2847 Looks up the web sites pertaining to the book with the given
2848 biblionumber.
2849
2850 C<$count> is the number of elements in C<@websites>.
2851
2852 C<@websites> is an array of references-to-hash; the keys are the
2853 fields from the C<websites> table in the Koha database.
2854
2855 =cut
2856 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2857 #(with add / modify / delete subs)
2858
2859 sub getwebsites {
2860     my ($biblionumber) = @_;
2861     my $dbh   = C4::Context->dbh;
2862     my $sth   = $dbh->prepare("Select * from websites where biblionumber = ?");
2863     my $count = 0;
2864     my @results;
2865
2866     $sth->execute($biblionumber);
2867     while (my $data = $sth->fetchrow_hashref) {
2868         # FIXME - The URL scheme shouldn't be stripped off, at least
2869         # not here, since it's part of the URL, and will be useful in
2870         # constructing a link to the site. If you don't want the user
2871         # to see the "http://" part, strip that off when building the
2872         # HTML code.
2873         $data->{'url'} =~ s/^http:\/\///;       # FIXME - Leaning toothpick
2874                                                 # syndrome
2875         $results[$count] = $data;
2876         $count++;
2877     } # while
2878
2879     $sth->finish;
2880     return($count, @results);
2881 } # sub getwebsites
2882
2883 =head2 getwebbiblioitems
2884
2885   ($count, @results) = &getwebbiblioitems($biblionumber);
2886
2887 Given a book's biblionumber, looks up the web versions of the book
2888 (biblioitems with itemtype C<WEB>).
2889
2890 C<$count> is the number of items in C<@results>. C<@results> is an
2891 array of references-to-hash; the keys are the items from the
2892 C<biblioitems> table of the Koha database.
2893
2894 =cut
2895 #'
2896 sub getwebbiblioitems {
2897     my ($biblionumber) = @_;
2898     my $dbh   = C4::Context->dbh;
2899     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2900 and itemtype = 'WEB'");
2901     my $count = 0;
2902     my @results;
2903
2904     $sth->execute($biblionumber);
2905     while (my $data = $sth->fetchrow_hashref) {
2906         $data->{'url'} =~ s/^http:\/\///;
2907         $results[$count] = $data;
2908         $count++;
2909     } # while
2910
2911     $sth->finish;
2912     return($count, @results);
2913 } # sub getwebbiblioitems
2914
2915 sub nsb_clean {
2916     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2917     my $NSE = '\x89';    # NSE : Non Sorting Block end
2918                          # handles non sorting blocks
2919     my ($string) = @_;
2920     $_ = $string;
2921     s/$NSB/(/gm;
2922     s/[ ]{0,1}$NSE/) /gm;
2923     $string = $_;
2924     return ($string);
2925 }
2926
2927 sub FindDuplicate {
2928         my ($record)=@_;
2929         my $dbh = C4::Context->dbh;
2930         my $result = MARCmarc2koha($dbh,$record,'');
2931         my $sth;
2932         my ($biblionumber,$bibid,$title);
2933         # search duplicate on ISBN, easy and fast...
2934         if ($result->{isbn}) {
2935                 $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=?");
2936                 $sth->execute($result->{'isbn'});
2937                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2938                 return $biblionumber,$bibid,$title if ($biblionumber);
2939         }
2940         # a more complex search : build a request for SearchMarc::catalogsearch()
2941         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2942         # search on biblio.title
2943         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2944         if ($record->field($tag)) {
2945                 if ($record->field($tag)->subfields($subfield)) {
2946                         push @tags, "'".$tag.$subfield."'";
2947                         push @and_or, "and";
2948                         push @excluding, "";
2949                         push @operator, "contains";
2950                         push @value, $record->field($tag)->subfield($subfield);
2951 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2952                 }
2953         }
2954         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle","");
2955         if ($record->field($tag)) {
2956                 if ($record->field($tag)->subfields($subfield)) {
2957                         push @tags, "'".$tag.$subfield."'";
2958                         push @and_or, "and";
2959                         push @excluding, "";
2960                         push @operator, "contains";
2961                         push @value, $record->field($tag)->subfield($subfield);
2962 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2963                 }
2964         }
2965         # ... and on biblio.author
2966         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2967         if ($record->field($tag)) {
2968                 if ($record->field($tag)->subfields($subfield)) {
2969                         push @tags, "'".$tag.$subfield."'";
2970                         push @and_or, "and";
2971                         push @excluding, "";
2972                         push @operator, "contains";
2973                         push @value, $record->field($tag)->subfield($subfield);
2974 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2975                 }
2976         }
2977         # ... and on publicationyear.
2978         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2979         if ($record->field($tag)) {
2980                 if ($record->field($tag)->subfields($subfield)) {
2981                         push @tags, "'".$tag.$subfield."'";
2982                         push @and_or, "and";
2983                         push @excluding, "";
2984                         push @operator, "=";
2985                         push @value, $record->field($tag)->subfield($subfield);
2986 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2987                 }
2988         }
2989         # ... and on size.
2990         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2991         if ($record->field($tag)) {
2992                 if ($record->field($tag)->subfields($subfield)) {
2993                         push @tags, "'".$tag.$subfield."'";
2994                         push @and_or, "and";
2995                         push @excluding, "";
2996                         push @operator, "=";
2997                         push @value, $record->field($tag)->subfield($subfield);
2998 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2999                 }
3000         }
3001         # ... and on publisher.
3002         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
3003         if ($record->field($tag)) {
3004                 if ($record->field($tag)->subfields($subfield)) {
3005                         push @tags, "'".$tag.$subfield."'";
3006                         push @and_or, "and";
3007                         push @excluding, "";
3008                         push @operator, "=";
3009                         push @value, $record->field($tag)->subfield($subfield);
3010 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
3011                 }
3012         }
3013         # ... and on volume.
3014         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
3015         if ($record->field($tag)) {
3016                 if ($record->field($tag)->subfields($subfield)) {
3017                         push @tags, "'".$tag.$subfield."'";
3018                         push @and_or, "and";
3019                         push @excluding, "";
3020                         push @operator, "=";
3021                         push @value, $record->field($tag)->subfield($subfield);
3022 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
3023                 }
3024         }
3025
3026         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
3027         # there is at least 1 result => return the 1st one
3028         if ($nbresult) {
3029 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
3030                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
3031         }
3032         # no result, returns nothing
3033         return;
3034 }
3035
3036 sub DisplayISBN {
3037         my ($isbn)=@_;
3038         my $seg1;
3039         if(substr($isbn, 0, 1) <=7) {
3040                 $seg1 = substr($isbn, 0, 1);
3041         } elsif(substr($isbn, 0, 2) <= 94) {
3042                 $seg1 = substr($isbn, 0, 2);
3043         } elsif(substr($isbn, 0, 3) <= 995) {
3044                 $seg1 = substr($isbn, 0, 3);
3045         } elsif(substr($isbn, 0, 4) <= 9989) {
3046                 $seg1 = substr($isbn, 0, 4);
3047         } else {
3048                 $seg1 = substr($isbn, 0, 5);
3049         }
3050         my $x = substr($isbn, length($seg1));
3051         my $seg2;
3052         if(substr($x, 0, 2) <= 19) {
3053 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
3054                 $seg2 = substr($x, 0, 2);
3055         } elsif(substr($x, 0, 3) <= 699) {
3056                 $seg2 = substr($x, 0, 3);
3057         } elsif(substr($x, 0, 4) <= 8399) {
3058                 $seg2 = substr($x, 0, 4);
3059         } elsif(substr($x, 0, 5) <= 89999) {
3060                 $seg2 = substr($x, 0, 5);
3061         } elsif(substr($x, 0, 6) <= 9499999) {
3062                 $seg2 = substr($x, 0, 6);
3063         } else {
3064                 $seg2 = substr($x, 0, 7);
3065         }
3066         my $seg3=substr($x,length($seg2));
3067         $seg3=substr($seg3,0,length($seg3)-1) ;
3068         my $seg4 = substr($x, -1, 1);
3069         return "$seg1-$seg2-$seg3-$seg4";
3070 }
3071
3072 =head2 get_itemnumbers_of
3073
3074   my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
3075
3076 Given a list of biblionumbers, return the list of corresponding itemnumbers
3077 for each biblionumber.
3078
3079 Return a reference on a hash where keys are biblionumbers and values are
3080 references on array of itemnumbers.
3081
3082 =cut
3083 sub get_itemnumbers_of {
3084     my @biblionumbers = @_;
3085
3086     my $dbh = C4::Context->dbh;
3087
3088     my $query = '
3089 SELECT itemnumber,
3090        biblionumber
3091   FROM items
3092   WHERE biblionumber IN (?'.(',?' x scalar @biblionumbers - 1).')
3093 ';
3094     my $sth = $dbh->prepare($query);
3095     $sth->execute(@biblionumbers);
3096
3097     my %itemnumbers_of;
3098
3099     while (my ($itemnumber, $biblionumber) = $sth->fetchrow_array) {
3100         push @{$itemnumbers_of{$biblionumber}}, $itemnumber;
3101     }
3102
3103     return \%itemnumbers_of;
3104 }
3105
3106 sub get_iteminfos_of {
3107     my @itemnumbers = @_;
3108
3109     my $query = '
3110 SELECT *
3111   FROM items
3112   WHERE itemnumber IN ('.join(',', @itemnumbers).')
3113 ';
3114     return get_infos_of($query, 'itemnumber');
3115 }
3116
3117 sub get_biblioiteminfos_of {
3118     my @biblioitemnumbers = @_;
3119
3120     my $query = '
3121 SELECT biblioitemnumber,
3122        publicationyear,
3123        itemtype
3124   FROM biblioitems
3125   WHERE biblioitemnumber IN ('.join(',', @biblioitemnumbers).')
3126 ';
3127
3128     return get_infos_of($query, 'biblioitemnumber');
3129 }
3130
3131 END { }    # module clean-up code here (global destructor)
3132
3133 =back
3134
3135 =head1 AUTHOR
3136
3137 Koha Developement team <info@koha.org>
3138
3139 Paul POULAIN paul.poulain@free.fr
3140
3141 =cut
3142
3143 # $Id$
3144 # $Log$
3145 # Revision 1.174  2006/07/12 13:43:42  btoumi
3146 # bug fixing:
3147 # Biblio.pm: add in export line  getbibliofromitemnumber function
3148 # fines2.pl:call to biblio.pm for use of getbibliofromitemnumber function
3149 #
3150 # Revision 1.173  2006/07/04 14:36:51  toins
3151 # Head & rel_2_2 merged
3152 #
3153 # Revision 1.172  2006/06/06 23:13:14  bob_lyon
3154 # Merging katipo changes...
3155 #
3156 # altering subject search to stop returning blank rows
3157 #
3158 # Revision 1.171  2006/05/17 16:06:24  plg
3159 # New feature from SAN Ouest Provence: ability to reserve a specific item in
3160 # the intranet. The development was made on branch 2.2 by Arnaud Laurin from
3161 # Ouest Provence and integrated on HEAD by Pierrick Le Gall from INEO media
3162 # system.
3163 #
3164 # New page reserve/request.pl taking a biblionumber as entry point.
3165 #
3166 # New functions:
3167 #
3168 # - C4::Biblio::get_iteminfos_of retrieves item informations for a list of
3169 #   itemnumbers
3170 #
3171 # - C4::Biblio::get_biblioiteminfos_of retrieves biblioitem informations for a
3172 #   list of biblioitemnumbers
3173 #
3174 # - C4::Biblio::get_itemnumbers_of retrieve the list of itemnumbers related to
3175 #   each biblionumber given in argument.
3176 #
3177 # - C4::Circulation::Circ2::get_return_date_of retrieves return date for a
3178 #   list of itemnumbers.
3179 #
3180 # - C4::Koha::get_itemtypeinfos_of retrieves the informations related to a
3181 #   list of itemtypes.
3182 #
3183 # - C4::Koha::get_branchinfos_of retrieves the informations related to a list
3184 #   of branchcodes.
3185 #
3186 # - C4::Koha::get_notforloan_label_of retrives the list of status/label for
3187 #   the authorised_values related to notforloan.
3188 #
3189 # - C4::Koha::get_infos_of is the generic function used by all get_*infos_of.
3190 #
3191 # - C4::Reserves2::GetNumberReservesFromBorrower
3192 #
3193 # - C4::Reserves2::GetFirstReserveDateFromItem
3194 #
3195 # Modified functions:
3196 #
3197 # - C4::Reserves2::FindReserves was simplified to be more readable.
3198 #
3199 # The reservation page is reserve/request.pl and is linked from nowhere as
3200 # long as zebra is not stable yet on HEAD.
3201 #
3202 # Revision 1.170  2006/04/15 02:47:47  tgarip1957
3203 # Change the MARC Leader to UTF-8 incase user did not set it. Important for Zebra.
3204 # The new M::F::XML is sensitive to leader settings
3205 #
3206 # Revision 1.169  2006/04/10 20:39:49  tgarip1957
3207 # 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
3208 #
3209 # Revision 1.168  2006/04/03 04:00:02  rangi
3210 # Modify item now works
3211 #
3212 # BUT only if there is only one item, if there is more than one item, it gets messed up.
3213 # They get combined into the form, ill work on this next
3214 #
3215 # Revision 1.167  2006/04/03 02:12:49  kados
3216 # some modifs to improve plugin support
3217 #
3218 # Revision 1.166  2006/04/01 22:10:50  rangi
3219 # Fixing the problem that all items were getting biblioitem=1 set
3220 #
3221 # Revision 1.165  2006/04/01 21:22:05  rangi
3222 # Adding a little fake subroutine that a few scripts in the opac depend on, can be removed once the opac scripts are rewritten
3223 #
3224 # Revision 1.164  2006/03/29 01:56:25  rangi
3225 # Delete isnt working using the extended services method
3226 #
3227 # Revision 1.163  2006/03/28 23:05:08  rangi
3228 # Delete working now
3229 #
3230 # Revision 1.162  2006/03/13 23:12:44  rangi
3231 # Adding commits, so that changes stick
3232 #
3233 # Revision 1.161  2006/03/10 02:40:38  kados
3234 # syncing MARChtml2xml wtih rel_2_2, removing unused MARChtml2marc
3235 #
3236 # Revision 1.160  2006/03/07 22:00:18  kados
3237 # adding support for 'delete' function
3238 #
3239 # Revision 1.159  2006/03/07 21:54:47  rangi
3240 # Starting work on deletes
3241 #
3242 # Revision 1.158  2006/03/06 02:45:41  kados
3243 # Adding fixes to MARC editor to HEAD
3244 #
3245 # Revision 1.157  2006/03/01 03:07:54  kados
3246 # rollback ... by accident I committed a rel_2_2 Biblio.pm
3247 #
3248 # Revision 1.155  2006/02/27 01:08:31  kados
3249 # Removing 'our Zconn' from top...
3250 #
3251 # Revision 1.154  2006/02/26 00:08:20  kados
3252 # moving all $Zconn s to z3950_extended_services (currently, nothing
3253 # works).
3254 #
3255 # Revision 1.153  2006/02/25 22:39:10  kados
3256 # Another purely documentation commit. Just changing formatting to ease
3257 # readability.
3258 #
3259 # Revision 1.152  2006/02/25 21:17:20  kados
3260 # Purely documentation change: converted all =head2 entries to use function
3261 # name as title rather than usage as title
3262 #
3263 # Revision 1.151  2006/02/25 21:02:20  kados
3264 #
3265 # Further cleanup, convering new routines to 4-chars
3266 #
3267 # Revision 1.150  2006/02/25 20:49:15  kados
3268 # Better documentation, added warning if serviceType is 'drop' since it's
3269 # not supported in Zebra.
3270 #
3271 # Revision 1.149  2006/02/25 20:30:32  kados
3272 # IMPORTANT: Paul, I've removed the decode_char routine because it's no
3273 # longer necessary. If we need to convert from MARC-8 for display, we should:
3274 #
3275 # 1. use utf-8
3276 # 2. do it with MARC::Charset
3277 #
3278 # If you still need it, let me know and I'll put it back in.
3279 #
3280 # Revision 1.148  2006/02/25 19:23:01  kados
3281 # cleaning up POD docs, deleting zebra_create as it's no longer used (
3282 # replaced by z3950_extended_services).
3283 #
3284 # Revision 1.147  2006/02/25 19:09:59  kados
3285 # readding some lost subs
3286 #
3287 # Revision 1.145  2006/02/22 01:02:39  kados
3288 # Replacing all calls to zebra_update with calls to
3289 # z3950_extended_services. More work coming, but it's
3290 # working now.
3291 #
3292 # Revision 1.144  2006/02/20 14:22:38  kados
3293 # typo
3294 #
3295 # Revision 1.143  2006/02/20 13:26:11  kados
3296 # A new subroutine to handle Z39.50 extended services. You pass it a
3297 # connection object, service type, service options, and a record, and
3298 # it performs the service and handles any exception found.
3299 #
3300 # Revision 1.142  2006/02/16 20:49:56  kados
3301 # destroy a connection after we're done -- we really should just have one
3302 # connection object and not destroy it until the whole transaction is
3303 # finished -- but this will do for now
3304 #
3305 # Revision 1.141  2006/02/16 19:47:22  rangi
3306 # Trying to error trap a little more.
3307 #
3308 # Revision 1.140  2006/02/14 21:36:03  kados
3309 # adding a 'use ZOOM' to biblio.pm, needed for non-mod_perl install.
3310 # also adding diagnostic error if not able to connect to Zebra
3311 #
3312 # Revision 1.139  2006/02/14 19:53:25  rangi
3313 # Just a little missing my
3314 #
3315 # Seems to be working great Paul, and I like what you did with zebradb
3316 #
3317 # Revision 1.138  2006/02/14 11:25:22  tipaul
3318 # road to 3.0 : updating a biblio in zebra seems to work. Still working on it, there are probably some bugs !
3319 #
3320 # Revision 1.137  2006/02/13 16:34:26  tipaul
3321 # fixing some warnings (perl -w should be quiet)
3322 #
3323 # Revision 1.136  2006/01/10 17:01:29  tipaul
3324 # adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
3325 #
3326 # Revision 1.135  2006/01/06 16:39:37  tipaul
3327 # synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
3328 # Seems not to break too many things, but i'm probably wrong here.
3329 # at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
3330 #
3331 # - removing useless directories (koha-html and koha-plucene)
3332 #
3333 # Revision 1.134  2006/01/04 15:54:55  tipaul
3334 # utf8 is a : go for beta test in HEAD.
3335 # some explanations :
3336 # - 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.
3337 # - *-top.inc will show the pages in utf8
3338 # - 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.
3339 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
3340 #
3341 # Revision 1.133  2005/12/12 14:25:51  thd
3342 #
3343 #
3344 # Reverse array filled with elements from repeated subfields
3345 # to avoid last to first concatenation of elements in Koha DB.-
3346 #
3347 # Revision 1.132  2005-10-26 09:12:33  tipaul
3348 # big commit, still breaking things...
3349 #
3350 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
3351 # * code cleaning (cleaning warnings from perl -w) continued
3352 #
3353 # Revision 1.131  2005/09/22 10:01:45  tipaul
3354 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
3355 #
3356 # Revision 1.130  2005/09/02 14:34:14  tipaul
3357 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
3358 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
3359 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
3360 #
3361 # Revision 1.129  2005/08/12 13:50:31  tipaul
3362 # removing useless sub declarations
3363 #
3364 # Revision 1.128  2005/08/11 16:12:47  tipaul
3365 # Playing with the zebra...
3366 #
3367 # * go to koha cvs home directory
3368 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
3369 # * put your zebra.cfg files here & create your database.
3370 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
3371 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
3372 #
3373 # NOTE :
3374 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
3375 # * deletion still not work
3376 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
3377 # in zebra.cfg :
3378 # recordId: (bib1,Local-number)
3379 # storeKeys:1
3380 #
3381 # in .abs file :
3382 # elm 090            Local-number            -
3383 # elm 090/?          Local-number            -
3384 # elm 090/?/9        Local-number            !:w
3385 #
3386 # (090$9 being the field mapped to biblio.biblionumber in Koha)
3387 #
3388 # Revision 1.127  2005/08/11 14:37:32  tipaul
3389 # * POD documenting
3390 # * removing useless subs
3391 # * removing some subs that are also elsewhere
3392 # * 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)
3393 #
3394 # Revision 1.126  2005/08/11 09:13:28  tipaul
3395 # just removing useless subs (a lot !!!) for code cleaning
3396 #
3397 # Revision 1.125  2005/08/11 09:00:07  tipaul
3398 # Ok guys, this time, it seems that item add and modif begin working as expected...
3399 # Still a lot of bugs to fix, of course
3400 #
3401 # Revision 1.124  2005/08/10 10:21:15  tipaul
3402 # continuing the road to zebra :
3403 # - the biblio add begins to work.
3404 # - the biblio modif begins to work.
3405 #
3406 # (still without doing anything on zebra)
3407 # (no new change in updatedatabase)
3408 #
3409 # Revision 1.123  2005/08/09 14:10:28  tipaul
3410 # 1st commit to go to zebra.
3411 # don't update your cvs if you want to have a working head...
3412 #
3413 # this commit contains :
3414 # * 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...
3415 # * 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.
3416 # * other files : get rid of bibid and use biblionumber instead.
3417 #
3418 # What is broken :
3419 # * does not do anything on zebra yet.
3420 # * if you rename marc_subfield_table, you can't search anymore.
3421 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
3422 # * 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 ;-) )
3423 #
3424 # 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
3425 # 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.
3426
3427 # tipaul cutted previous commit notes