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