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