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