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                         next if ($temp =~/itemcallnumber/);
1800             $query .= "$temp = ?,";
1801             push ( @bind, $data->{$temp} );
1802         }
1803         $query =~ s/\,$//;
1804         my $sth2 = $dbh->prepare($query);
1805         $sth2->execute(@bind);
1806     }    # while
1807     $sth->finish;
1808     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1809     $sth->execute($biblioitemnumber);
1810     $sth->finish();
1811
1812     #    $dbh->disconnect;
1813 }    # sub deletebiblioitem
1814
1815 =head2 REALdelbiblio($dbh,$biblio);
1816
1817 =over 4
1818
1819 delete a biblio
1820
1821 =back
1822
1823 =cut
1824
1825 sub REALdelbiblio {
1826     my ( $dbh, $biblio ) = @_;
1827     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1828     $sth->execute($biblio);
1829     if ( my $data = $sth->fetchrow_hashref ) {
1830         $sth->finish;
1831         my $query = "Insert into deletedbiblio set ";
1832         my @bind  = ();
1833         foreach my $temp ( keys %$data ) {
1834             $query .= "$temp = ?,";
1835             push ( @bind, $data->{$temp} );
1836         }
1837
1838         #replacing the last , by ",?)"
1839         $query =~ s/\,$//;
1840         $sth = $dbh->prepare($query);
1841         $sth->execute(@bind);
1842         $sth->finish;
1843         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1844         $sth->execute($biblio);
1845         $sth->finish;
1846     }
1847     $sth->finish;
1848 }
1849
1850 =head2 itemcount
1851
1852 $number = itemcount($biblio);
1853
1854 =over 4
1855
1856 returns the number of items attached to a biblio
1857
1858 =back
1859
1860 =cut
1861
1862 sub itemcount {
1863     my ($biblio) = @_;
1864     my $dbh = C4::Context->dbh;
1865
1866     #  print $query;
1867     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1868     $sth->execute($biblio);
1869     my $data = $sth->fetchrow_hashref;
1870     $sth->finish;
1871     return ( $data->{'count(*)'} );
1872 }
1873
1874 =head2 newbiblio
1875
1876 $biblionumber = newbiblio($biblio);
1877
1878 =over 4
1879
1880 create a biblio. The parameter is a hash
1881
1882 =back
1883
1884 =cut
1885
1886 sub newbiblio {
1887     my ($biblio) = @_;
1888     my $dbh    = C4::Context->dbh;
1889     my $bibnum = REALnewbiblio( $dbh, $biblio );
1890     # finds new (MARC bibid
1891     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1892 #     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1893 #     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1894     return ($bibnum);
1895 }
1896
1897 =head2  modbiblio
1898
1899 $biblionumber = &modbiblio($biblio);
1900
1901 =over 4
1902
1903 Update a biblio record.
1904
1905 C<$biblio> is a reference-to-hash whose keys are the fields in the
1906 biblio table in the Koha database. All fields must be present, not
1907 just the ones you wish to change.
1908
1909 C<&modbiblio> updates the record defined by
1910 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1911
1912 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1913 successful or not.
1914
1915 =back
1916
1917 =cut
1918
1919 sub modbiblio {
1920         my ($biblio) = @_;
1921         my $dbh  = C4::Context->dbh;
1922         my $biblionumber=REALmodbiblio($dbh,$biblio);
1923         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1924         # finds new (MARC bibid
1925         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1926         MARCmodbiblio($dbh,$bibid,$record,"",0);
1927         return($biblionumber);
1928 } # sub modbiblio
1929
1930 =head2 &modsubtitle($biblionumber, $subtitle);
1931
1932 =over 4
1933
1934 Sets the subtitle of a book.
1935
1936 C<$biblionumber> is the biblionumber of the book to modify.
1937
1938 C<$subtitle> is the new subtitle.
1939
1940 =back
1941
1942 =cut
1943
1944 sub modsubtitle {
1945     my ( $bibnum, $subtitle ) = @_;
1946     my $dbh = C4::Context->dbh;
1947     &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1948 }    # sub modsubtitle
1949
1950 =head2 &modaddauthor($biblionumber, $author);
1951
1952 =over 4
1953
1954 Replaces all additional authors for the book with biblio number
1955 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1956 C<&modaddauthor> deletes all additional authors.
1957
1958 =back
1959
1960 =cut
1961
1962 sub modaddauthor {
1963     my ( $bibnum, @authors ) = @_;
1964     my $dbh = C4::Context->dbh;
1965     &REALmodaddauthor( $dbh, $bibnum, @authors );
1966 }    # sub modaddauthor
1967
1968 =head2 modsubject
1969
1970 $error = &modsubject($biblionumber, $force, @subjects);
1971
1972 =over 4
1973
1974 $force - a subject to force
1975 $error - Error message, or undef if successful.
1976
1977 =back
1978
1979 =cut
1980
1981 sub modsubject {
1982     my ( $bibnum, $force, @subject ) = @_;
1983     my $dbh = C4::Context->dbh;
1984     my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1985     if ($error eq ''){
1986                 # When MARC is off, ensures that the MARC biblio table gets updated with new
1987                 # subjects, of course, it deletes the biblio in marc, and then recreates.
1988                 # This check is to ensure that no MARC data exists to lose.
1989 #               if (C4::Context->preference("MARC") eq '0'){
1990 #               warn "in modSUBJECT";
1991 #                       my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1992 #                       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1993 #                       &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1994 #               }
1995         }
1996         return ($error);
1997 }    # sub modsubject
1998
1999 =head2 modbibitem($dbh, $biblioitem);
2000
2001 =over 4
2002
2003 modify a biblioitem. The parameter is a hash
2004
2005 =back
2006
2007 =cut
2008
2009 sub modbibitem {
2010     my ($dbh, $biblioitem) = @_;
2011     #my $dbh = C4::Context->dbh;
2012     &REALmodbiblioitem( $dbh, $biblioitem );
2013 }    # sub modbibitem
2014
2015 =head2 newbiblioitem
2016
2017 $biblioitemnumber = newbiblioitem($biblioitem)
2018
2019 =over 4
2020
2021 create a biblioitem, the parameter is a hash
2022
2023 =back
2024
2025 =cut
2026
2027 sub newbiblioitem {
2028     my ($biblioitem) = @_;
2029     my $dbh        = C4::Context->dbh;
2030         # add biblio information to the hash
2031     my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
2032         $biblioitem->{marc} = $MARCbiblio->as_usmarc();
2033     my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
2034     return ($bibitemnum);
2035 }
2036
2037 =head2 newsubtitle($biblionumber,$subtitle);
2038
2039 =over 4
2040
2041 insert a subtitle for $biblionumber biblio
2042
2043 =back
2044
2045 =cut
2046
2047
2048 sub newsubtitle {
2049     my ( $bibnum, $subtitle ) = @_;
2050     my $dbh = C4::Context->dbh;
2051     &REALnewsubtitle( $dbh, $bibnum, $subtitle );
2052 }
2053
2054 =head2 newitems
2055
2056 $errors = newitems($dbh, $item, @barcodes);
2057
2058 =over 4
2059
2060 insert items ($item is a hash)
2061
2062 =back
2063
2064 =cut
2065
2066
2067 sub newitems {
2068     my ( $dbh, $item, @barcodes ) = @_;
2069     #my $dbh = C4::Context->dbh;
2070     my $errors;
2071     my $itemnumber;
2072     my $error;
2073     foreach my $barcode (@barcodes) {
2074                 # add items, one by one for each barcode.
2075                 my $oneitem=$item;
2076                 $oneitem->{barcode}= $barcode;
2077         my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
2078                 $oneitem->{marc} = $MARCitem->as_usmarc;
2079         ( $itemnumber, $error ) = &REALnewitems( $dbh, $oneitem);
2080 #         $errors .= $error;
2081 #         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
2082     }
2083     return ($errors);
2084 }
2085
2086 =head2 moditem($dbh,$item);
2087
2088 =over 4
2089
2090 modify an item ($item is a hash with all item informations)
2091
2092 =back
2093
2094 =cut
2095
2096
2097 sub moditem {
2098     my ($dbh, $item) = @_;
2099     #my $dbh = C4::Context->dbh;
2100     &REALmoditem( $dbh, $item );
2101     my $MARCitem =
2102       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
2103     my $bibid =
2104       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
2105     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
2106 }
2107
2108 =head2 checkitems
2109
2110 $error = checkitems($count,@barcodes);
2111
2112 =over 4
2113
2114 check for each @barcode entry that the barcode is not a duplicate
2115
2116 =back
2117
2118 =cut
2119
2120 sub checkitems {
2121     my ( $count, @barcodes ) = @_;
2122     my $dbh = C4::Context->dbh;
2123     my $error;
2124     my $sth = $dbh->prepare("Select * from items where barcode=?");
2125     for ( my $i = 0 ; $i < $count ; $i++ ) {
2126         $barcodes[$i] = uc $barcodes[$i];
2127         $sth->execute( $barcodes[$i] );
2128         if ( my $data = $sth->fetchrow_hashref ) {
2129             $error .= " Duplicate Barcode: $barcodes[$i]";
2130         }
2131     }
2132     $sth->finish;
2133     return ($error);
2134 }
2135
2136 =head2 delitem($itemnum);
2137
2138 =over 4
2139
2140 delete item $itemnum being the item number to delete
2141
2142 =back
2143
2144 =cut
2145
2146 sub delitem {
2147     my ($itemnum) = @_;
2148     my $dbh = C4::Context->dbh;
2149     &REALdelitem( $dbh, $itemnum );
2150 }
2151
2152 =head2 deletebiblioitem($biblioitemnumber);
2153
2154 =over 4
2155
2156 delete the biblioitem $biblioitemnumber
2157
2158 =back
2159
2160 =cut
2161
2162 sub deletebiblioitem {
2163     my ($biblioitemnumber) = @_;
2164     my $dbh = C4::Context->dbh;
2165     &REALdelbiblioitem( $dbh, $biblioitemnumber );
2166 }    # sub deletebiblioitem
2167
2168 =head2 delbiblio($biblionumber)
2169
2170 =over 4
2171
2172 delete biblio $biblionumber
2173
2174 =back
2175
2176 =cut
2177
2178 sub delbiblio {
2179     my ($biblio) = @_;
2180     my $dbh = C4::Context->dbh;
2181     &REALdelbiblio( $dbh, $biblio );
2182     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
2183     &MARCdelbiblio( $dbh, $bibid, 0 );
2184 }
2185
2186 =head2 getbiblio
2187
2188 ($count,@results) = getbiblio($biblionumber);
2189
2190 =over 4
2191
2192 return an array with hash of biblios.
2193
2194 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
2195
2196 =back
2197
2198 =cut
2199
2200 sub getbiblio {
2201     my ($biblionumber) = @_;
2202     my $dbh = C4::Context->dbh;
2203     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
2204
2205     # || die "Cannot prepare $query\n" . $dbh->errstr;
2206     my $count = 0;
2207     my @results;
2208
2209     $sth->execute($biblionumber);
2210
2211     # || die "Cannot execute $query\n" . $sth->errstr;
2212     while ( my $data = $sth->fetchrow_hashref ) {
2213         $results[$count] = $data;
2214         $count++;
2215     }    # while
2216
2217     $sth->finish;
2218     return ( $count, @results );
2219 }    # sub getbiblio
2220
2221 =head2 bibdata
2222
2223   $data = &bibdata($biblionumber, $type);
2224
2225 Returns information about the book with the given biblionumber.
2226
2227 C<$type> is ignored.
2228
2229 C<&bibdata> returns a reference-to-hash. The keys are the fields in
2230 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
2231 Koha database.
2232
2233 In addition, C<$data-E<gt>{subject}> is the list of the book's
2234 subjects, separated by C<" , "> (space, comma, space).
2235
2236 If there are multiple biblioitems with the given biblionumber, only
2237 the first one is considered.
2238
2239 =cut
2240 #'
2241 sub bibdata {
2242         my ($bibnum, $type) = @_;
2243         my $dbh   = C4::Context->dbh;
2244         my $sth   = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
2245                                                                 from biblio
2246                                                                 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
2247                                                                 left join bibliosubtitle on
2248                                                                 biblio.biblionumber = bibliosubtitle.biblionumber
2249                                                                 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
2250                                                                 where biblio.biblionumber = ?
2251                                                                 ");
2252         $sth->execute($bibnum);
2253         my $data;
2254         $data  = $sth->fetchrow_hashref;
2255         $sth->finish;
2256         # handle management of repeated subtitle
2257         $sth   = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
2258         $sth->execute($bibnum);
2259         my @subtitles;
2260         while (my $dat = $sth->fetchrow_hashref){
2261                 my %line;
2262                 $line{subtitle} = $dat->{subtitle};
2263                 push @subtitles, \%line;
2264         } # while
2265         $data->{subtitles} = \@subtitles;
2266         $sth->finish;
2267         $sth   = $dbh->prepare("SELECT * FROM bibliosubject
2268                                 WHERE subject != ''
2269                                 AND biblionumber = ?");
2270         $sth->execute($bibnum);
2271         my @subjects;
2272         while (my $dat = $sth->fetchrow_hashref){
2273                 my %line;
2274                 $line{subject} = $dat->{'subject'};
2275                 push @subjects, \%line;
2276         } # while
2277         $data->{subjects} = \@subjects;
2278         $sth->finish;
2279         $sth   = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
2280         $sth->execute($bibnum);
2281         while (my $dat = $sth->fetchrow_hashref){
2282                 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
2283         } # while
2284         chop $data->{'additionalauthors'};
2285         chop $data->{'additionalauthors'};
2286         chop $data->{'additionalauthors'};
2287         $sth->finish;
2288         return($data);
2289 } # sub bibdata
2290
2291 =head2 getbiblioitem
2292
2293 ($count,@results) = getbiblioitem($biblioitemnumber);
2294
2295 =over 4
2296
2297 return an array with hash of biblioitemss.
2298
2299 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
2300
2301 =back
2302
2303 =cut
2304
2305 sub getbiblioitem {
2306     my ($biblioitemnum) = @_;
2307     my $dbh = C4::Context->dbh;
2308     my $sth = $dbh->prepare( "Select * from biblioitems where
2309 biblioitemnumber = ?"
2310     );
2311     my $count = 0;
2312     my @results;
2313
2314     $sth->execute($biblioitemnum);
2315
2316     while ( my $data = $sth->fetchrow_hashref ) {
2317         $results[$count] = $data;
2318         $count++;
2319     }    # while
2320
2321     $sth->finish;
2322     return ( $count, @results );
2323 }    # sub getbiblioitem
2324
2325 =head2 getbiblioitembybiblionumber
2326
2327 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
2328
2329 =over 4
2330
2331 return an array with hash of biblioitems for the given biblionumber.
2332
2333 =back
2334
2335 =cut
2336
2337 sub getbiblioitembybiblionumber {
2338     my ($biblionumber) = @_;
2339     my $dbh = C4::Context->dbh;
2340     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2341     my $count = 0;
2342     my @results;
2343
2344     $sth->execute($biblionumber);
2345
2346     while ( my $data = $sth->fetchrow_hashref ) {
2347         $results[$count] = $data;
2348         $count++;
2349     }    # while
2350
2351     $sth->finish;
2352     return ( $count, @results );
2353 }    # sub
2354
2355 =head2 getitemsbybiblioitem
2356
2357 ($count,@results) = getitemsbybiblioitem($biblionumber);
2358
2359 =over 4
2360
2361 returns an array with hash of items
2362
2363 =back
2364
2365 =cut
2366
2367 sub getitemsbybiblioitem {
2368     my ($biblioitemnum) = @_;
2369     my $dbh = C4::Context->dbh;
2370     my $sth = $dbh->prepare( "Select * from items, biblio where
2371 biblio.biblionumber = items.biblionumber and biblioitemnumber
2372 = ?"
2373     );
2374
2375     # || die "Cannot prepare $query\n" . $dbh->errstr;
2376     my $count = 0;
2377     my @results;
2378
2379     $sth->execute($biblioitemnum);
2380
2381     # || die "Cannot execute $query\n" . $sth->errstr;
2382     while ( my $data = $sth->fetchrow_hashref ) {
2383         $results[$count] = $data;
2384         $count++;
2385     }    # while
2386
2387     $sth->finish;
2388     return ( $count, @results );
2389 }    # sub getitemsbybiblioitem
2390
2391 =head2 ItemInfo
2392
2393   @results = &ItemInfo($env, $biblionumber, $type);
2394
2395 Returns information about books with the given biblionumber.
2396
2397 C<$type> may be either C<intra> or anything else. If it is not set to
2398 C<intra>, then the search will exclude lost, very overdue, and
2399 withdrawn items.
2400
2401 C<$env> is ignored.
2402
2403 C<&ItemInfo> returns a list of references-to-hash. Each element
2404 contains a number of keys. Most of them are table items from the
2405 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2406 Koha database. Other keys include:
2407
2408 =over 4
2409
2410 =item C<$data-E<gt>{branchname}>
2411
2412 The name (not the code) of the branch to which the book belongs.
2413
2414 =item C<$data-E<gt>{datelastseen}>
2415
2416 This is simply C<items.datelastseen>, except that while the date is
2417 stored in YYYY-MM-DD format in the database, here it is converted to
2418 DD/MM/YYYY format. A NULL date is returned as C<//>.
2419
2420 =item C<$data-E<gt>{datedue}>
2421
2422 =item C<$data-E<gt>{class}>
2423
2424 This is the concatenation of C<biblioitems.classification>, the book's
2425 Dewey code, and C<biblioitems.subclass>.
2426
2427 =item C<$data-E<gt>{ocount}>
2428
2429 I think this is the number of copies of the book available.
2430
2431 =item C<$data-E<gt>{order}>
2432
2433 If this is set, it is set to C<One Order>.
2434
2435 =back
2436
2437 =cut
2438 #'
2439 sub ItemInfo {
2440         my ($env,$biblionumber,$type) = @_;
2441         my $dbh   = C4::Context->dbh;
2442         my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2443                                         left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2444                                         WHERE items.biblionumber = ?
2445                                         AND biblioitems.biblioitemnumber = items.biblioitemnumber
2446                                         AND biblio.biblionumber = items.biblionumber";
2447         $query .= " order by items.dateaccessioned desc";
2448         my $sth=$dbh->prepare($query);
2449         $sth->execute($biblionumber);
2450         my $i=0;
2451         my @results;
2452         while (my $data=$sth->fetchrow_hashref){
2453                 my $datedue = '';
2454                 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2455                 $isth->execute($data->{'itemnumber'});
2456                 if (my $idata=$isth->fetchrow_hashref){
2457                 $data->{borrowernumber} = $idata->{borrowernumber};
2458                 $data->{cardnumber} = $idata->{cardnumber};
2459                 $datedue = format_date($idata->{'date_due'});
2460                 }
2461                 if ($datedue eq ''){
2462                         my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2463                         if ($restype) {
2464                                 $datedue=$restype;
2465                         }
2466                 }
2467                 $isth->finish;
2468         #get branch information.....
2469                 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2470                 $bsth->execute($data->{'holdingbranch'});
2471                 if (my $bdata=$bsth->fetchrow_hashref){
2472                         $data->{'branchname'} = $bdata->{'branchname'};
2473                 }
2474                 my $date=format_date($data->{'datelastseen'});
2475                 $data->{'datelastseen'}=$date;
2476                 $data->{'datedue'}=$datedue;
2477         # get notforloan complete status if applicable
2478                 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2479                 $sthnflstatus->execute;
2480                 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2481                 if ($authorised_valuecode) {
2482                         $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2483                         $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2484                         my ($lib) = $sthnflstatus->fetchrow;
2485                         $data->{notforloan} = $lib;
2486                 }
2487                 $results[$i]=$data;
2488                 $i++;
2489         }
2490         $sth->finish;
2491         return(@results);
2492 }
2493
2494 =head2 bibitems
2495
2496   ($count, @results) = &bibitems($biblionumber);
2497
2498 Given the biblionumber for a book, C<&bibitems> looks up that book's
2499 biblioitems (different publications of the same book, the audio book
2500 and film versions, etc.).
2501
2502 C<$count> is the number of elements in C<@results>.
2503
2504 C<@results> is an array of references-to-hash; the keys are the fields
2505 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2506 addition, C<itemlost> indicates the availability of the item: if it is
2507 "2", then all copies of the item are long overdue; if it is "1", then
2508 all copies are lost; otherwise, there is at least one copy available.
2509
2510 =cut
2511 #'
2512 sub bibitems {
2513     my ($bibnum) = @_;
2514
2515     my $dbh   = C4::Context->dbh;
2516     my $sth   = $dbh->prepare("SELECT biblioitems.*,
2517                         itemtypes.*,
2518                         MIN(items.itemlost)        as itemlost,
2519                         MIN(items.dateaccessioned) as dateaccessioned
2520                           FROM biblioitems, itemtypes, items
2521                          WHERE biblioitems.biblionumber     = ?
2522                            AND biblioitems.itemtype         = itemtypes.itemtype
2523                            AND biblioitems.biblioitemnumber = items.biblioitemnumber
2524                       GROUP BY items.biblioitemnumber");
2525     my $count = 0;
2526     my @results;
2527     $sth->execute($bibnum);
2528     while (my $data = $sth->fetchrow_hashref) {
2529         $results[$count] = $data;
2530         $count++;
2531     } # while
2532     $sth->finish;
2533     return($count, @results);
2534 } # sub bibitems
2535
2536
2537 =head2 bibitemdata
2538
2539   $itemdata = &bibitemdata($biblioitemnumber);
2540
2541 Looks up the biblioitem with the given biblioitemnumber. Returns a
2542 reference-to-hash. The keys are the fields from the C<biblio>,
2543 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2544 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2545
2546 =cut
2547 #'
2548 sub bibitemdata {
2549     my ($bibitem) = @_;
2550     my $dbh   = C4::Context->dbh;
2551     my $sth   = $dbh->prepare("Select *,biblioitems.notes as bnotes from biblio, biblioitems,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype");
2552     my $data;
2553
2554     $sth->execute($bibitem);
2555
2556     $data = $sth->fetchrow_hashref;
2557
2558     $sth->finish;
2559     return($data);
2560 } # sub bibitemdata
2561
2562
2563 =head2 getbibliofromitemnumber
2564
2565   $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2566
2567 Looks up the item with the given itemnumber.
2568
2569 C<$env> and C<$dbh> are ignored.
2570
2571 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2572 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2573 database.
2574
2575 =cut
2576 #'
2577 sub getbibliofromitemnumber {
2578   my ($env,$dbh,$itemnumber) = @_;
2579   $dbh = C4::Context->dbh;
2580   my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2581     where items.itemnumber = ?
2582     and biblio.biblionumber = items.biblionumber
2583     and biblioitems.biblioitemnumber = items.biblioitemnumber");
2584 #  print $query;
2585   $sth->execute($itemnumber);
2586   my $data=$sth->fetchrow_hashref;
2587   $sth->finish;
2588   return($data);
2589 }
2590
2591 =head2 barcodes
2592
2593   @barcodes = &barcodes($biblioitemnumber);
2594
2595 Given a biblioitemnumber, looks up the corresponding items.
2596
2597 Returns an array of references-to-hash; the keys are C<barcode> and
2598 C<itemlost>.
2599
2600 The returned items include very overdue items, but not lost ones.
2601
2602 =cut
2603 #'
2604 sub barcodes{
2605     #called from request.pl
2606     my ($biblioitemnumber)=@_;
2607     my $dbh = C4::Context->dbh;
2608     my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2609                            WHERE biblioitemnumber = ?
2610                              AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2611     $sth->execute($biblioitemnumber);
2612     my @barcodes;
2613     my $i=0;
2614     while (my $data=$sth->fetchrow_hashref){
2615         $barcodes[$i]=$data;
2616         $i++;
2617     }
2618     $sth->finish;
2619     return(@barcodes);
2620 }
2621
2622
2623 =head2 itemdata
2624
2625   $item = &itemdata($barcode);
2626
2627 Looks up the item with the given barcode, and returns a
2628 reference-to-hash containing information about that item. The keys of
2629 the hash are the fields from the C<items> and C<biblioitems> tables in
2630 the Koha database.
2631
2632 =cut
2633 #'
2634 sub get_item_from_barcode {
2635   my ($barcode)=@_;
2636   my $dbh = C4::Context->dbh;
2637   my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2638   and items.biblioitemnumber=biblioitems.biblioitemnumber");
2639   $sth->execute($barcode);
2640   my $data=$sth->fetchrow_hashref;
2641   $sth->finish;
2642   return($data);
2643 }
2644
2645
2646 =head2 itemissues
2647
2648   @issues = &itemissues($biblioitemnumber, $biblio);
2649
2650 Looks up information about who has borrowed the bookZ<>(s) with the
2651 given biblioitemnumber.
2652
2653 C<$biblio> is ignored.
2654
2655 C<&itemissues> returns an array of references-to-hash. The keys
2656 include the fields from the C<items> table in the Koha database.
2657 Additional keys include:
2658
2659 =over 4
2660
2661 =item C<date_due>
2662
2663 If the item is currently on loan, this gives the due date.
2664
2665 If the item is not on loan, then this is either "Available" or
2666 "Cancelled", if the item has been withdrawn.
2667
2668 =item C<card>
2669
2670 If the item is currently on loan, this gives the card number of the
2671 patron who currently has the item.
2672
2673 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2674
2675 These give the timestamp for the last three times the item was
2676 borrowed.
2677
2678 =item C<card0>, C<card1>, C<card2>
2679
2680 The card number of the last three patrons who borrowed this item.
2681
2682 =item C<borrower0>, C<borrower1>, C<borrower2>
2683
2684 The borrower number of the last three patrons who borrowed this item.
2685
2686 =back
2687
2688 =cut
2689 #'
2690 sub itemissues {
2691     my ($bibitem, $biblio)=@_;
2692     my $dbh   = C4::Context->dbh;
2693     # FIXME - If this function die()s, the script will abort, and the
2694     # user won't get anything; depending on how far the script has
2695     # gotten, the user might get a blank page. It would be much better
2696     # to at least print an error message. The easiest way to do this
2697     # is to set $SIG{__DIE__}.
2698     my $sth   = $dbh->prepare("Select * from items where
2699 items.biblioitemnumber = ?")
2700       || die $dbh->errstr;
2701     my $i     = 0;
2702     my @results;
2703
2704     $sth->execute($bibitem)
2705       || die $sth->errstr;
2706
2707     while (my $data = $sth->fetchrow_hashref) {
2708         # Find out who currently has this item.
2709         # FIXME - Wouldn't it be better to do this as a left join of
2710         # some sort? Currently, this code assumes that if
2711         # fetchrow_hashref() fails, then the book is on the shelf.
2712         # fetchrow_hashref() can fail for any number of reasons (e.g.,
2713         # database server crash), not just because no items match the
2714         # search criteria.
2715         my $sth2   = $dbh->prepare("select * from issues,borrowers
2716 where itemnumber = ?
2717 and returndate is NULL
2718 and issues.borrowernumber = borrowers.borrowernumber");
2719
2720         $sth2->execute($data->{'itemnumber'});
2721         if (my $data2 = $sth2->fetchrow_hashref) {
2722             $data->{'date_due'} = $data2->{'date_due'};
2723             $data->{'card'}     = $data2->{'cardnumber'};
2724             $data->{'borrower'}     = $data2->{'borrowernumber'};
2725         } else {
2726             if ($data->{'wthdrawn'} eq '1') {
2727                 $data->{'date_due'} = 'Cancelled';
2728             } else {
2729                 $data->{'date_due'} = 'Available';
2730             } # else
2731         } # else
2732
2733         $sth2->finish;
2734
2735         # Find the last 3 people who borrowed this item.
2736         $sth2 = $dbh->prepare("select * from issues, borrowers
2737                                                 where itemnumber = ?
2738                                                                         and issues.borrowernumber = borrowers.borrowernumber
2739                                                                         and returndate is not NULL
2740                                                                         order by returndate desc,timestamp desc") || die $dbh->errstr;
2741         $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2742         for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2743             if (my $data2 = $sth2->fetchrow_hashref) {
2744                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2745                 $data->{"card$i2"}      = $data2->{'cardnumber'};
2746                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
2747             } # if
2748         } # for
2749
2750         $sth2->finish;
2751         $results[$i] = $data;
2752         $i++;
2753     }
2754
2755     $sth->finish;
2756     return(@results);
2757 }
2758
2759 =head2 getsubject
2760
2761   ($count, $subjects) = &getsubject($biblionumber);
2762
2763 Looks up the subjects of the book with the given biblionumber. Returns
2764 a two-element list. C<$subjects> is a reference-to-array, where each
2765 element is a subject of the book, and C<$count> is the number of
2766 elements in C<$subjects>.
2767
2768 =cut
2769 #'
2770 sub getsubject {
2771   my ($bibnum)=@_;
2772   my $dbh = C4::Context->dbh;
2773   my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2774   $sth->execute($bibnum);
2775   my @results;
2776   my $i=0;
2777   while (my $data=$sth->fetchrow_hashref){
2778     $results[$i]=$data;
2779     $i++;
2780   }
2781   $sth->finish;
2782   return($i,\@results);
2783 }
2784
2785 =head2 getaddauthor
2786
2787   ($count, $authors) = &getaddauthor($biblionumber);
2788
2789 Looks up the additional authors for the book with the given
2790 biblionumber.
2791
2792 Returns a two-element list. C<$authors> is a reference-to-array, where
2793 each element is an additional author, and C<$count> is the number of
2794 elements in C<$authors>.
2795
2796 =cut
2797 #'
2798 sub getaddauthor {
2799   my ($bibnum)=@_;
2800   my $dbh = C4::Context->dbh;
2801   my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2802   $sth->execute($bibnum);
2803   my @results;
2804   my $i=0;
2805   while (my $data=$sth->fetchrow_hashref){
2806     $results[$i]=$data;
2807     $i++;
2808   }
2809   $sth->finish;
2810   return($i,\@results);
2811 }
2812
2813
2814 =head2 getsubtitle
2815
2816   ($count, $subtitles) = &getsubtitle($biblionumber);
2817
2818 Looks up the subtitles for the book with the given biblionumber.
2819
2820 Returns a two-element list. C<$subtitles> is a reference-to-array,
2821 where each element is a subtitle, and C<$count> is the number of
2822 elements in C<$subtitles>.
2823
2824 =cut
2825 #'
2826 sub getsubtitle {
2827   my ($bibnum)=@_;
2828   my $dbh = C4::Context->dbh;
2829   my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2830   $sth->execute($bibnum);
2831   my @results;
2832   my $i=0;
2833   while (my $data=$sth->fetchrow_hashref){
2834     $results[$i]=$data;
2835     $i++;
2836   }
2837   $sth->finish;
2838   return($i,\@results);
2839 }
2840
2841
2842 =head2 getwebsites
2843
2844   ($count, @websites) = &getwebsites($biblionumber);
2845
2846 Looks up the web sites pertaining to the book with the given
2847 biblionumber.
2848
2849 C<$count> is the number of elements in C<@websites>.
2850
2851 C<@websites> is an array of references-to-hash; the keys are the
2852 fields from the C<websites> table in the Koha database.
2853
2854 =cut
2855 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2856 #(with add / modify / delete subs)
2857
2858 sub getwebsites {
2859     my ($biblionumber) = @_;
2860     my $dbh   = C4::Context->dbh;
2861     my $sth   = $dbh->prepare("Select * from websites where biblionumber = ?");
2862     my $count = 0;
2863     my @results;
2864
2865     $sth->execute($biblionumber);
2866     while (my $data = $sth->fetchrow_hashref) {
2867         # FIXME - The URL scheme shouldn't be stripped off, at least
2868         # not here, since it's part of the URL, and will be useful in
2869         # constructing a link to the site. If you don't want the user
2870         # to see the "http://" part, strip that off when building the
2871         # HTML code.
2872         $data->{'url'} =~ s/^http:\/\///;       # FIXME - Leaning toothpick
2873                                                 # syndrome
2874         $results[$count] = $data;
2875         $count++;
2876     } # while
2877
2878     $sth->finish;
2879     return($count, @results);
2880 } # sub getwebsites
2881
2882 =head2 getwebbiblioitems
2883
2884   ($count, @results) = &getwebbiblioitems($biblionumber);
2885
2886 Given a book's biblionumber, looks up the web versions of the book
2887 (biblioitems with itemtype C<WEB>).
2888
2889 C<$count> is the number of items in C<@results>. C<@results> is an
2890 array of references-to-hash; the keys are the items from the
2891 C<biblioitems> table of the Koha database.
2892
2893 =cut
2894 #'
2895 sub getwebbiblioitems {
2896     my ($biblionumber) = @_;
2897     my $dbh   = C4::Context->dbh;
2898     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2899 and itemtype = 'WEB'");
2900     my $count = 0;
2901     my @results;
2902
2903     $sth->execute($biblionumber);
2904     while (my $data = $sth->fetchrow_hashref) {
2905         $data->{'url'} =~ s/^http:\/\///;
2906         $results[$count] = $data;
2907         $count++;
2908     } # while
2909
2910     $sth->finish;
2911     return($count, @results);
2912 } # sub getwebbiblioitems
2913
2914 sub nsb_clean {
2915     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2916     my $NSE = '\x89';    # NSE : Non Sorting Block end
2917                          # handles non sorting blocks
2918     my ($string) = @_;
2919     $_ = $string;
2920     s/$NSB/(/gm;
2921     s/[ ]{0,1}$NSE/) /gm;
2922     $string = $_;
2923     return ($string);
2924 }
2925
2926 sub FindDuplicate {
2927         my ($record)=@_;
2928         my $dbh = C4::Context->dbh;
2929         my $result = MARCmarc2koha($dbh,$record,'');
2930         my $sth;
2931         my ($biblionumber,$bibid,$title);
2932         # search duplicate on ISBN, easy and fast...
2933         if ($result->{isbn}) {
2934                 $sth = $dbh->prepare("select biblio.biblionumber,bibid,title from biblio,biblioitems,marc_biblio where biblio.biblionumber=biblioitems.biblionumber and marc_biblio.biblionumber=biblioitems.biblionumber and isbn=?");
2935                 $sth->execute($result->{'isbn'});
2936                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2937                 return $biblionumber,$bibid,$title if ($biblionumber);
2938         }
2939         # a more complex search : build a request for SearchMarc::catalogsearch()
2940         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2941         # search on biblio.title
2942         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2943         if ($record->field($tag)) {
2944                 if ($record->field($tag)->subfields($subfield)) {
2945                         push @tags, "'".$tag.$subfield."'";
2946                         push @and_or, "and";
2947                         push @excluding, "";
2948                         push @operator, "contains";
2949                         push @value, $record->field($tag)->subfield($subfield);
2950 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2951                 }
2952         }
2953         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle","");
2954         if ($record->field($tag)) {
2955                 if ($record->field($tag)->subfields($subfield)) {
2956                         push @tags, "'".$tag.$subfield."'";
2957                         push @and_or, "and";
2958                         push @excluding, "";
2959                         push @operator, "contains";
2960                         push @value, $record->field($tag)->subfield($subfield);
2961 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2962                 }
2963         }
2964         # ... and on biblio.author
2965         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2966         if ($record->field($tag)) {
2967                 if ($record->field($tag)->subfields($subfield)) {
2968                         push @tags, "'".$tag.$subfield."'";
2969                         push @and_or, "and";
2970                         push @excluding, "";
2971                         push @operator, "contains";
2972                         push @value, $record->field($tag)->subfield($subfield);
2973 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2974                 }
2975         }
2976         # ... and on publicationyear.
2977         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2978         if ($record->field($tag)) {
2979                 if ($record->field($tag)->subfields($subfield)) {
2980                         push @tags, "'".$tag.$subfield."'";
2981                         push @and_or, "and";
2982                         push @excluding, "";
2983                         push @operator, "=";
2984                         push @value, $record->field($tag)->subfield($subfield);
2985 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2986                 }
2987         }
2988         # ... and on size.
2989         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2990         if ($record->field($tag)) {
2991                 if ($record->field($tag)->subfields($subfield)) {
2992                         push @tags, "'".$tag.$subfield."'";
2993                         push @and_or, "and";
2994                         push @excluding, "";
2995                         push @operator, "=";
2996                         push @value, $record->field($tag)->subfield($subfield);
2997 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2998                 }
2999         }
3000         # ... and on publisher.
3001         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
3002         if ($record->field($tag)) {
3003                 if ($record->field($tag)->subfields($subfield)) {
3004                         push @tags, "'".$tag.$subfield."'";
3005                         push @and_or, "and";
3006                         push @excluding, "";
3007                         push @operator, "=";
3008                         push @value, $record->field($tag)->subfield($subfield);
3009 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
3010                 }
3011         }
3012         # ... and on volume.
3013         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
3014         if ($record->field($tag)) {
3015                 if ($record->field($tag)->subfields($subfield)) {
3016                         push @tags, "'".$tag.$subfield."'";
3017                         push @and_or, "and";
3018                         push @excluding, "";
3019                         push @operator, "=";
3020                         push @value, $record->field($tag)->subfield($subfield);
3021 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
3022                 }
3023         }
3024
3025         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
3026         # there is at least 1 result => return the 1st one
3027         if ($nbresult) {
3028 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
3029                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
3030         }
3031         # no result, returns nothing
3032         return;
3033 }
3034
3035 sub DisplayISBN {
3036         my ($isbn)=@_;
3037         my $seg1;
3038         if(substr($isbn, 0, 1) <=7) {
3039                 $seg1 = substr($isbn, 0, 1);
3040         } elsif(substr($isbn, 0, 2) <= 94) {
3041                 $seg1 = substr($isbn, 0, 2);
3042         } elsif(substr($isbn, 0, 3) <= 995) {
3043                 $seg1 = substr($isbn, 0, 3);
3044         } elsif(substr($isbn, 0, 4) <= 9989) {
3045                 $seg1 = substr($isbn, 0, 4);
3046         } else {
3047                 $seg1 = substr($isbn, 0, 5);
3048         }
3049         my $x = substr($isbn, length($seg1));
3050         my $seg2;
3051         if(substr($x, 0, 2) <= 19) {
3052 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
3053                 $seg2 = substr($x, 0, 2);
3054         } elsif(substr($x, 0, 3) <= 699) {
3055                 $seg2 = substr($x, 0, 3);
3056         } elsif(substr($x, 0, 4) <= 8399) {
3057                 $seg2 = substr($x, 0, 4);
3058         } elsif(substr($x, 0, 5) <= 89999) {
3059                 $seg2 = substr($x, 0, 5);
3060         } elsif(substr($x, 0, 6) <= 9499999) {
3061                 $seg2 = substr($x, 0, 6);
3062         } else {
3063                 $seg2 = substr($x, 0, 7);
3064         }
3065         my $seg3=substr($x,length($seg2));
3066         $seg3=substr($seg3,0,length($seg3)-1) ;
3067         my $seg4 = substr($x, -1, 1);
3068         return "$seg1-$seg2-$seg3-$seg4";
3069 }
3070
3071 =head2 get_itemnumbers_of
3072
3073   my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
3074
3075 Given a list of biblionumbers, return the list of corresponding itemnumbers
3076 for each biblionumber.
3077
3078 Return a reference on a hash where keys are biblionumbers and values are
3079 references on array of itemnumbers.
3080
3081 =cut
3082 sub get_itemnumbers_of {
3083     my @biblionumbers = @_;
3084
3085     my $dbh = C4::Context->dbh;
3086
3087     my $query = '
3088 SELECT itemnumber,
3089        biblionumber
3090   FROM items
3091   WHERE biblionumber IN (?'.(',?' x scalar @biblionumbers - 1).')
3092 ';
3093     my $sth = $dbh->prepare($query);
3094     $sth->execute(@biblionumbers);
3095
3096     my %itemnumbers_of;
3097
3098     while (my ($itemnumber, $biblionumber) = $sth->fetchrow_array) {
3099         push @{$itemnumbers_of{$biblionumber}}, $itemnumber;
3100     }
3101
3102     return \%itemnumbers_of;
3103 }
3104
3105 sub get_iteminfos_of {
3106     my @itemnumbers = @_;
3107
3108     my $query = '
3109 SELECT *
3110   FROM items
3111   WHERE itemnumber IN ('.join(',', @itemnumbers).')
3112 ';
3113     return get_infos_of($query, 'itemnumber');
3114 }
3115
3116 sub get_biblioiteminfos_of {
3117     my @biblioitemnumbers = @_;
3118
3119     my $query = '
3120 SELECT biblioitemnumber,
3121        publicationyear,
3122        itemtype
3123   FROM biblioitems
3124   WHERE biblioitemnumber IN ('.join(',', @biblioitemnumbers).')
3125 ';
3126
3127     return get_infos_of($query, 'biblioitemnumber');
3128 }
3129
3130 END { }    # module clean-up code here (global destructor)
3131
3132 =back
3133
3134 =head1 AUTHOR
3135
3136 Koha Developement team <info@koha.org>
3137
3138 Paul POULAIN paul.poulain@free.fr
3139
3140 =cut
3141
3142 # $Id$
3143 # $Log$
3144 # Revision 1.173  2006/07/04 14:36:51  toins
3145 # Head & rel_2_2 merged
3146 #
3147 # Revision 1.172  2006/06/06 23:13:14  bob_lyon
3148 # Merging katipo changes...
3149 #
3150 # altering subject search to stop returning blank rows
3151 #
3152 # Revision 1.171  2006/05/17 16:06:24  plg
3153 # New feature from SAN Ouest Provence: ability to reserve a specific item in
3154 # the intranet. The development was made on branch 2.2 by Arnaud Laurin from
3155 # Ouest Provence and integrated on HEAD by Pierrick Le Gall from INEO media
3156 # system.
3157 #
3158 # New page reserve/request.pl taking a biblionumber as entry point.
3159 #
3160 # New functions:
3161 #
3162 # - C4::Biblio::get_iteminfos_of retrieves item informations for a list of
3163 #   itemnumbers
3164 #
3165 # - C4::Biblio::get_biblioiteminfos_of retrieves biblioitem informations for a
3166 #   list of biblioitemnumbers
3167 #
3168 # - C4::Biblio::get_itemnumbers_of retrieve the list of itemnumbers related to
3169 #   each biblionumber given in argument.
3170 #
3171 # - C4::Circulation::Circ2::get_return_date_of retrieves return date for a
3172 #   list of itemnumbers.
3173 #
3174 # - C4::Koha::get_itemtypeinfos_of retrieves the informations related to a
3175 #   list of itemtypes.
3176 #
3177 # - C4::Koha::get_branchinfos_of retrieves the informations related to a list
3178 #   of branchcodes.
3179 #
3180 # - C4::Koha::get_notforloan_label_of retrives the list of status/label for
3181 #   the authorised_values related to notforloan.
3182 #
3183 # - C4::Koha::get_infos_of is the generic function used by all get_*infos_of.
3184 #
3185 # - C4::Reserves2::GetNumberReservesFromBorrower
3186 #
3187 # - C4::Reserves2::GetFirstReserveDateFromItem
3188 #
3189 # Modified functions:
3190 #
3191 # - C4::Reserves2::FindReserves was simplified to be more readable.
3192 #
3193 # The reservation page is reserve/request.pl and is linked from nowhere as
3194 # long as zebra is not stable yet on HEAD.
3195 #
3196 # Revision 1.170  2006/04/15 02:47:47  tgarip1957
3197 # Change the MARC Leader to UTF-8 incase user did not set it. Important for Zebra.
3198 # The new M::F::XML is sensitive to leader settings
3199 #
3200 # Revision 1.169  2006/04/10 20:39:49  tgarip1957
3201 # 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
3202 #
3203 # Revision 1.168  2006/04/03 04:00:02  rangi
3204 # Modify item now works
3205 #
3206 # BUT only if there is only one item, if there is more than one item, it gets messed up.
3207 # They get combined into the form, ill work on this next
3208 #
3209 # Revision 1.167  2006/04/03 02:12:49  kados
3210 # some modifs to improve plugin support
3211 #
3212 # Revision 1.166  2006/04/01 22:10:50  rangi
3213 # Fixing the problem that all items were getting biblioitem=1 set
3214 #
3215 # Revision 1.165  2006/04/01 21:22:05  rangi
3216 # Adding a little fake subroutine that a few scripts in the opac depend on, can be removed once the opac scripts are rewritten
3217 #
3218 # Revision 1.164  2006/03/29 01:56:25  rangi
3219 # Delete isnt working using the extended services method
3220 #
3221 # Revision 1.163  2006/03/28 23:05:08  rangi
3222 # Delete working now
3223 #
3224 # Revision 1.162  2006/03/13 23:12:44  rangi
3225 # Adding commits, so that changes stick
3226 #
3227 # Revision 1.161  2006/03/10 02:40:38  kados
3228 # syncing MARChtml2xml wtih rel_2_2, removing unused MARChtml2marc
3229 #
3230 # Revision 1.160  2006/03/07 22:00:18  kados
3231 # adding support for 'delete' function
3232 #
3233 # Revision 1.159  2006/03/07 21:54:47  rangi
3234 # Starting work on deletes
3235 #
3236 # Revision 1.158  2006/03/06 02:45:41  kados
3237 # Adding fixes to MARC editor to HEAD
3238 #
3239 # Revision 1.157  2006/03/01 03:07:54  kados
3240 # rollback ... by accident I committed a rel_2_2 Biblio.pm
3241 #
3242 # Revision 1.155  2006/02/27 01:08:31  kados
3243 # Removing 'our Zconn' from top...
3244 #
3245 # Revision 1.154  2006/02/26 00:08:20  kados
3246 # moving all $Zconn s to z3950_extended_services (currently, nothing
3247 # works).
3248 #
3249 # Revision 1.153  2006/02/25 22:39:10  kados
3250 # Another purely documentation commit. Just changing formatting to ease
3251 # readability.
3252 #
3253 # Revision 1.152  2006/02/25 21:17:20  kados
3254 # Purely documentation change: converted all =head2 entries to use function
3255 # name as title rather than usage as title
3256 #
3257 # Revision 1.151  2006/02/25 21:02:20  kados
3258 #
3259 # Further cleanup, convering new routines to 4-chars
3260 #
3261 # Revision 1.150  2006/02/25 20:49:15  kados
3262 # Better documentation, added warning if serviceType is 'drop' since it's
3263 # not supported in Zebra.
3264 #
3265 # Revision 1.149  2006/02/25 20:30:32  kados
3266 # IMPORTANT: Paul, I've removed the decode_char routine because it's no
3267 # longer necessary. If we need to convert from MARC-8 for display, we should:
3268 #
3269 # 1. use utf-8
3270 # 2. do it with MARC::Charset
3271 #
3272 # If you still need it, let me know and I'll put it back in.
3273 #
3274 # Revision 1.148  2006/02/25 19:23:01  kados
3275 # cleaning up POD docs, deleting zebra_create as it's no longer used (
3276 # replaced by z3950_extended_services).
3277 #
3278 # Revision 1.147  2006/02/25 19:09:59  kados
3279 # readding some lost subs
3280 #
3281 # Revision 1.145  2006/02/22 01:02:39  kados
3282 # Replacing all calls to zebra_update with calls to
3283 # z3950_extended_services. More work coming, but it's
3284 # working now.
3285 #
3286 # Revision 1.144  2006/02/20 14:22:38  kados
3287 # typo
3288 #
3289 # Revision 1.143  2006/02/20 13:26:11  kados
3290 # A new subroutine to handle Z39.50 extended services. You pass it a
3291 # connection object, service type, service options, and a record, and
3292 # it performs the service and handles any exception found.
3293 #
3294 # Revision 1.142  2006/02/16 20:49:56  kados
3295 # destroy a connection after we're done -- we really should just have one
3296 # connection object and not destroy it until the whole transaction is
3297 # finished -- but this will do for now
3298 #
3299 # Revision 1.141  2006/02/16 19:47:22  rangi
3300 # Trying to error trap a little more.
3301 #
3302 # Revision 1.140  2006/02/14 21:36:03  kados
3303 # adding a 'use ZOOM' to biblio.pm, needed for non-mod_perl install.
3304 # also adding diagnostic error if not able to connect to Zebra
3305 #
3306 # Revision 1.139  2006/02/14 19:53:25  rangi
3307 # Just a little missing my
3308 #
3309 # Seems to be working great Paul, and I like what you did with zebradb
3310 #
3311 # Revision 1.138  2006/02/14 11:25:22  tipaul
3312 # road to 3.0 : updating a biblio in zebra seems to work. Still working on it, there are probably some bugs !
3313 #
3314 # Revision 1.137  2006/02/13 16:34:26  tipaul
3315 # fixing some warnings (perl -w should be quiet)
3316 #
3317 # Revision 1.136  2006/01/10 17:01:29  tipaul
3318 # adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
3319 #
3320 # Revision 1.135  2006/01/06 16:39:37  tipaul
3321 # synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
3322 # Seems not to break too many things, but i'm probably wrong here.
3323 # at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
3324 #
3325 # - removing useless directories (koha-html and koha-plucene)
3326 #
3327 # Revision 1.134  2006/01/04 15:54:55  tipaul
3328 # utf8 is a : go for beta test in HEAD.
3329 # some explanations :
3330 # - 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.
3331 # - *-top.inc will show the pages in utf8
3332 # - 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.
3333 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
3334 #
3335 # Revision 1.133  2005/12/12 14:25:51  thd
3336 #
3337 #
3338 # Reverse array filled with elements from repeated subfields
3339 # to avoid last to first concatenation of elements in Koha DB.-
3340 #
3341 # Revision 1.132  2005-10-26 09:12:33  tipaul
3342 # big commit, still breaking things...
3343 #
3344 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
3345 # * code cleaning (cleaning warnings from perl -w) continued
3346 #
3347 # Revision 1.131  2005/09/22 10:01:45  tipaul
3348 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
3349 #
3350 # Revision 1.130  2005/09/02 14:34:14  tipaul
3351 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
3352 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
3353 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
3354 #
3355 # Revision 1.129  2005/08/12 13:50:31  tipaul
3356 # removing useless sub declarations
3357 #
3358 # Revision 1.128  2005/08/11 16:12:47  tipaul
3359 # Playing with the zebra...
3360 #
3361 # * go to koha cvs home directory
3362 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
3363 # * put your zebra.cfg files here & create your database.
3364 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
3365 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
3366 #
3367 # NOTE :
3368 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
3369 # * deletion still not work
3370 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
3371 # in zebra.cfg :
3372 # recordId: (bib1,Local-number)
3373 # storeKeys:1
3374 #
3375 # in .abs file :
3376 # elm 090            Local-number            -
3377 # elm 090/?          Local-number            -
3378 # elm 090/?/9        Local-number            !:w
3379 #
3380 # (090$9 being the field mapped to biblio.biblionumber in Koha)
3381 #
3382 # Revision 1.127  2005/08/11 14:37:32  tipaul
3383 # * POD documenting
3384 # * removing useless subs
3385 # * removing some subs that are also elsewhere
3386 # * 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)
3387 #
3388 # Revision 1.126  2005/08/11 09:13:28  tipaul
3389 # just removing useless subs (a lot !!!) for code cleaning
3390 #
3391 # Revision 1.125  2005/08/11 09:00:07  tipaul
3392 # Ok guys, this time, it seems that item add and modif begin working as expected...
3393 # Still a lot of bugs to fix, of course
3394 #
3395 # Revision 1.124  2005/08/10 10:21:15  tipaul
3396 # continuing the road to zebra :
3397 # - the biblio add begins to work.
3398 # - the biblio modif begins to work.
3399 #
3400 # (still without doing anything on zebra)
3401 # (no new change in updatedatabase)
3402 #
3403 # Revision 1.123  2005/08/09 14:10:28  tipaul
3404 # 1st commit to go to zebra.
3405 # don't update your cvs if you want to have a working head...
3406 #
3407 # this commit contains :
3408 # * 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...
3409 # * 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.
3410 # * other files : get rid of bibid and use biblionumber instead.
3411 #
3412 # What is broken :
3413 # * does not do anything on zebra yet.
3414 # * if you rename marc_subfield_table, you can't search anymore.
3415 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
3416 # * 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 ;-) )
3417 #
3418 # 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
3419 # 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.
3420
3421 # tipaul cutted previous commit notes