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