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