koha-dev.rot13.org Git - koha_fer/blob - C4/Biblio.pm

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