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