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