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