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 MARC::Record;
  25 use MARC::File::USMARC;
  26 use MARC::File::XML;
  27
  28 use vars qw($VERSION @ISA @EXPORT);
  29
  30 # set the version for version checking
  31 $VERSION = 0.01;
  32
  33 @ISA = qw(Exporter);
  34
  35 #
  36 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
  37 # as the old-style API and the NEW one are the only public functions.
  38 #
  39 @EXPORT = qw(
  40   &updateBiblio &updateBiblioItem &updateItem
  41   &itemcount &newbiblio &newbiblioitem
  42   &newsubject &newsubtitle
  43   &modbiblio &checkitems
  44   &newitems &modbibitem
  45   &modsubtitle &modsubject &modaddauthor &moditem
  46   &delitem &deletebiblioitem &delbiblio
  47   &getbiblio
  48   &getbiblioitembybiblionumber
  49   &getbiblioitem &getitemsbybiblioitem
  50   &skip
  51   &newcompletebiblioitem
  52
  53   &MARCfind_marc_from_kohafield
  54   &MARCfind_frameworkcode
  55   &find_biblioitemnumber
  56   &MARCgettagslib
  57
  58   &NEWnewbiblio &NEWnewitem
  59   &NEWmodbiblio &NEWmoditem
  60   &NEWdelbiblio &NEWdelitem
  61   &NEWmodbiblioframework
  62
  63   &MARCkoha2marcBiblio &MARCmarc2koha
  64   &MARCkoha2marcItem &MARChtml2marc
  65   &MARCgetbiblio &MARCgetitem
  66   &char_decode
  67
  68   &FindDuplicate
  69   &DisplayISBN
  70 );
  71
  72 =head1 NAME
  73
  74 C4::Biblio - acquisition, catalog  management functions
  75
  76 =head1 SYNOPSIS
  77
  78 ( lot of changes for Koha 3.0)
  79
  80 Koha 1.2 and previous version used a specific API to manage biblios. This API uses old-DB style parameters.
  81 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors, bibliosubject and bibliosubtitle where applicable)
  82
  83 In Koha 2.0, we introduced a MARC-DB.
  84
  85 In Koha 3.0 we removed this MARC-DB for search as we wanted to use Zebra as search system.
  86
  87 So in Koha 3.0, saving a record means :
  88  - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items informations.
  89  - storing the "decoded information" in biblio/biblioitems/items as previously.
  90  - using zebra to manage search & indexing on the MARC datas.
  91
  92  In Koha, there is a systempreference saying "MARC=ON" or "MARC=OFF"
  93
  94  * MARC=ON : when MARC=ON, koha uses a MARC::Record object (in sub parameters). Saving informations in the DB means :
  95  - transform the MARC record into a hash
  96  - add the raw marc record into the hash
  97  - store them & update zebra
  98
  99  * MARC=OFF : when MARC=OFF, koha uses a hash object (in sub parameters). Saving informations in the DB means :
 100  - transform the hash into a MARC record
 101  - add the raw marc record into the hash
 102  - store them and update zebra
 103
 104
 105 That's why we need 3 types of subs :
 106
 107 =head2 REALxxx subs
 108
 109 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
 110
 111 =head2 NEWxxx related subs
 112
 113 =over 4
 114
 115 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.
 116
 117 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. they sometimes requires another parameter.
 118
 119 =back
 120
 121 =head2 something_elsexxx related subs
 122
 123 =over 4
 124
 125 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.
 126
 127 all subs requires/use $dbh as 1st parameter and a hash as 2nd parameter.
 128
 129 =back
 130
 131 =head1 API
 132
 133 =cut
 134
 135
 136 =head2 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
 137
 138 =over 4
 139
 140 2nd param is 1 for liblibrarian and 0 for libopac
 141 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
 142
 143 returns a hash with all values for all fields and subfields for a given MARC framework :
 144         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 145                     ->{tab}        = "";            # XXX
 146                     ->{mandatory}  = $mandatory;
 147                     ->{repeatable} = $repeatable;
 148                     ->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 149                                  ->{tab}              = $tab;
 150                                  ->{mandatory}        = $mandatory;
 151                                  ->{repeatable}       = $repeatable;
 152                                  ->{authorised_value} = $authorised_value;
 153                                  ->{authtypecode}     = $authtypecode;
 154                                  ->{value_builder}    = $value_builder;
 155                                  ->{kohafield}        = $kohafield;
 156                                  ->{seealso}          = $seealso;
 157                                  ->{hidden}           = $hidden;
 158                                  ->{isurl}            = $isurl;
 159                                  ->{link}            = $link;
 160
 161 =back
 162
 163 =cut
 164
 165 sub MARCgettagslib {
 166     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
 167     $frameworkcode = "" unless $frameworkcode;
 168     my $sth;
 169     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 170
 171     # check that framework exists
 172     $sth =
 173       $dbh->prepare(
 174         "select count(*) from marc_tag_structure where frameworkcode=?");
 175     $sth->execute($frameworkcode);
 176     my ($total) = $sth->fetchrow;
 177     $frameworkcode = "" unless ( $total > 0 );
 178     $sth =
 179       $dbh->prepare(
 180 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
 181     );
 182     $sth->execute($frameworkcode);
 183     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 184
 185     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
 186         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 187         $res->{$tab}->{tab}        = "";            # XXX
 188         $res->{$tag}->{mandatory}  = $mandatory;
 189         $res->{$tag}->{repeatable} = $repeatable;
 190     }
 191
 192     $sth =
 193       $dbh->prepare(
 194 "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"
 195     );
 196     $sth->execute($frameworkcode);
 197
 198     my $subfield;
 199     my $authorised_value;
 200     my $authtypecode;
 201     my $value_builder;
 202     my $kohafield;
 203     my $seealso;
 204     my $hidden;
 205     my $isurl;
 206         my $link;
 207
 208     while (
 209         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
 210         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 211         $value_builder, $kohafield,  $seealso,          $hidden,
 212         $isurl,                 $link )
 213         = $sth->fetchrow
 214       )
 215     {
 216         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 217         $res->{$tag}->{$subfield}->{tab}              = $tab;
 218         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 219         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 220         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 221         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 222         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 223         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 224         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 225         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 226         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 227         $res->{$tag}->{$subfield}->{link}            = $link;
 228     }
 229     return $res;
 230 }
 231
 232 =head2 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
 233
 234 =over 4
 235
 236 finds MARC tag and subfield for a given kohafield
 237 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
 238
 239 =back
 240
 241 =cut
 242
 243 sub MARCfind_marc_from_kohafield {
 244     my ( $dbh, $kohafield,$frameworkcode ) = @_;
 245     return 0, 0 unless $kohafield;
 246         my $relations = C4::Context->marcfromkohafield;
 247         return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
 248 }
 249
 250 =head2 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
 251
 252 =over 4
 253
 254 Returns a MARC::Record for the biblio $biblionumber.
 255
 256 =cut
 257
 258 sub MARCgetbiblio {
 259
 260     # Returns MARC::Record of the biblio passed in parameter.
 261     my ( $dbh, $biblionumber ) = @_;
 262         my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
 263         $sth->execute($biblionumber);
 264         my ($marc) = $sth->fetchrow;
 265         my $record = MARC::File::USMARC::decode($marc);
 266     return $record;
 267 }
 268
 269 =head2 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
 270
 271 =over 4
 272
 273 Returns a MARC::Record with all items of biblio # $biblionumber
 274
 275 =back
 276
 277 =cut
 278
 279 sub MARCgetitem {
 280
 281     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 282         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
 283         # get the complete MARC record
 284         my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
 285         $sth->execute($biblionumber);
 286         my ($rawmarc) = $sth->fetchrow;
 287         my $record = MARC::File::USMARC::decode($rawmarc);
 288         # now, find the relevant itemnumber
 289         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
 290         # prepare the new item record
 291         my $itemrecord = MARC::Record->new();
 292         # parse all fields fields from the complete record
 293         foreach ($record->field($itemnumberfield)) {
 294                 # when the item field is found, save it
 295                 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
 296                         $itemrecord->append_fields($_);
 297                 }
 298         }
 299
 300     return $itemrecord;
 301 }
 302
 303 =head2 sub find_biblioitemnumber($dbh,$biblionumber);
 304
 305 =over 4
 306
 307 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
 308 This sub is useless when MARC=OFF
 309
 310 =back
 311
 312 =cut
 313 sub find_biblioitemnumber {
 314         my ( $dbh, $biblionumber ) = @_;
 315         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 316         $sth->execute($biblionumber);
 317         my ($biblioitemnumber) = $sth->fetchrow;
 318         return $biblioitemnumber;
 319 }
 320
 321 =head2 $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
 322
 323 =over 4
 324
 325 returns the framework of a given biblio
 326
 327 =back
 328
 329 =cut
 330
 331 sub MARCfind_frameworkcode {
 332         my ( $dbh, $biblionumber ) = @_;
 333         my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
 334         $sth->execute($biblionumber);
 335         my ($frameworkcode) = $sth->fetchrow;
 336         return $frameworkcode;
 337 }
 338
 339 =head2 $MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);
 340
 341 =over 4
 342
 343 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
 344 all entries of the hash are transformed into their matching MARC field/subfield.
 345
 346 =back
 347
 348 =cut
 349
 350 sub MARCkoha2marcBiblio {
 351
 352     # this function builds partial MARC::Record from the old koha-DB fields
 353     my ( $dbh, $biblionumber, $biblioitemnumber ) = @_;
 354     my $sth =
 355       $dbh->prepare(
 356 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
 357     );
 358     my $record = MARC::Record->new();
 359
 360     #--- if bibid, then retrieve old-style koha data
 361     if ( $biblionumber > 0 ) {
 362         my $sth2 =
 363           $dbh->prepare(
 364 "select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
 365                 from biblio where biblionumber=?"
 366         );
 367         $sth2->execute($biblionumber);
 368         my $row = $sth2->fetchrow_hashref;
 369         my $code;
 370         foreach $code ( keys %$row ) {
 371             if ( $row->{$code} ) {
 372                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
 373                     $row->{$code}, '');
 374             }
 375         }
 376     }
 377
 378     #--- if biblioitem, then retrieve old-style koha data
 379     if ( $biblioitemnumber > 0 ) {
 380         my $sth2 =
 381           $dbh->prepare(
 382             " SELECT biblioitemnumber,biblionumber,volume,number,classification,
 383                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
 384                                                 volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
 385                                         FROM biblioitems
 386                                         WHERE biblioitemnumber=?
 387                                         "
 388         );
 389         $sth2->execute($biblioitemnumber);
 390         my $row = $sth2->fetchrow_hashref;
 391         my $code;
 392         foreach $code ( keys %$row ) {
 393             if ( $row->{$code} ) {
 394                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
 395                     $row->{$code},'' );
 396             }
 397         }
 398     }
 399
 400     # other fields => additional authors, subjects, subtitles
 401     my $sth2 =
 402       $dbh->prepare(
 403         " SELECT author FROM additionalauthors WHERE biblionumber=?");
 404     $sth2->execute($biblionumber);
 405     while ( my $row = $sth2->fetchrow_hashref ) {
 406         &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author",
 407             $row->{'author'},'' );
 408     }
 409     $sth2 =
 410       $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
 411     $sth2->execute($biblionumber);
 412     while ( my $row = $sth2->fetchrow_hashref ) {
 413         &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject",
 414             $row->{'subject'},'' );
 415     }
 416     $sth2 =
 417       $dbh->prepare(
 418         " SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
 419     $sth2->execute($biblionumber);
 420     while ( my $row = $sth2->fetchrow_hashref ) {
 421         &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
 422             $row->{'subtitle'},'' );
 423     }
 424     return $record;
 425 }
 426
 427 =head2 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
 428
 429 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
 430 all entries of the hash are transformed into their matching MARC field/subfield.
 431
 432 =over 4
 433
 434 =back
 435
 436 =cut
 437
 438 sub MARCkoha2marcItem {
 439
 440     # this function builds partial MARC::Record from the old koha-DB fields
 441     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 442
 443     #    my $dbh=&C4Connect;
 444     my $sth =
 445       $dbh->prepare(
 446 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
 447     );
 448     my $record = MARC::Record->new();
 449
 450     #--- if item, then retrieve old-style koha data
 451     if ( $itemnumber > 0 ) {
 452
 453         #       print STDERR "prepare $biblionumber,$itemnumber\n";
 454         my $sth2 =
 455           $dbh->prepare(
 456 "SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
 457                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
 458                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
 459                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
 460                                         FROM items
 461                                         WHERE itemnumber=?"
 462         );
 463         $sth2->execute($itemnumber);
 464         my $row = $sth2->fetchrow_hashref;
 465         my $code;
 466         foreach $code ( keys %$row ) {
 467             if ( $row->{$code} ) {
 468                 &MARCkoha2marcOnefield( $sth, $record, "items." . $code,
 469                     $row->{$code},'' );
 470             }
 471         }
 472     }
 473     return $record;
 474 }
 475
 476 =head2 MARCkoha2marcOnefield
 477
 478 =over 4
 479
 480 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
 481
 482 =back
 483
 484 =cut
 485
 486 sub MARCkoha2marcOnefield {
 487     my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
 488     my $tagfield;
 489     my $tagsubfield;
 490     $sth->execute($frameworkcode,$kohafieldname);
 491     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
 492         if ( $record->field($tagfield) ) {
 493             my $tag = $record->field($tagfield);
 494             if ($tag) {
 495                 $tag->add_subfields( $tagsubfield, $value );
 496                 $record->delete_field($tag);
 497                 $record->add_fields($tag);
 498             }
 499         }
 500         else {
 501             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
 502         }
 503     }
 504     return $record;
 505 }
 506
 507 =head2 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
 508
 509 =over 4
 510
 511 transforms the parameters (coming from HTML form) into a MARC::Record
 512 parameters with r are references to arrays.
 513
 514 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
 515
 516 =back
 517
 518 =cut
 519
 520 sub MARChtml2marc {
 521         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
 522         my $prevtag = -1;
 523         my $record = MARC::Record->new();
 524 #       my %subfieldlist=();
 525         my $prevvalue; # if tag <10
 526         my $field; # if tag >=10
 527         for (my $i=0; $i< @$rtags; $i++) {
 528                 next unless @$rvalues[$i];
 529                 # rebuild MARC::Record
 530 #                       warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
 531                 if (@$rtags[$i] ne $prevtag) {
 532                         if ($prevtag < 10) {
 533                                 if ($prevvalue) {
 534                                         if ($prevtag ne '000') {
 535                                                 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
 536                                         } else {
 537                                                 $record->leader($prevvalue);
 538                                         }
 539                                 }
 540                         } else {
 541                                 if ($field) {
 542                                         $record->add_fields($field);
 543                                 }
 544                         }
 545                         $indicators{@$rtags[$i]}.='  ';
 546                         if (@$rtags[$i] <10) {
 547                                 $prevvalue= @$rvalues[$i];
 548                                 undef $field;
 549                         } else {
 550                                 undef $prevvalue;
 551                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
 552 #                       warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 553                         }
 554                         $prevtag = @$rtags[$i];
 555                 } else {
 556                         if (@$rtags[$i] <10) {
 557                                 $prevvalue=@$rvalues[$i];
 558                         } else {
 559                                 if (length(@$rvalues[$i])>0) {
 560                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
 561 #                       warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 562                                 }
 563                         }
 564                         $prevtag= @$rtags[$i];
 565                 }
 566         }
 567         # the last has not been included inside the loop... do it now !
 568         $record->add_fields($field) if $field;
 569 #       warn "HTML2MARC=".$record->as_formatted;
 570         return $record;
 571 }
 572
 573
 574 =head2 $hash = &MARCmarc2koha($dbh,$MARCRecord);
 575
 576 =over 4
 577
 578 builds a hash with old-db datas from a MARC::Record
 579
 580 =back
 581
 582 =cut
 583
 584 sub MARCmarc2koha {
 585         my ($dbh,$record,$frameworkcode) = @_;
 586         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 587         my $result;
 588         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
 589         $sth2->execute;
 590         my $field;
 591         while (($field)=$sth2->fetchrow) {
 592                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
 593         }
 594         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
 595         $sth2->execute;
 596         while (($field)=$sth2->fetchrow) {
 597                 if ($field eq 'notes') { $field = 'bnotes'; }
 598                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
 599         }
 600         $sth2=$dbh->prepare("SHOW COLUMNS from items");
 601         $sth2->execute;
 602         while (($field)=$sth2->fetchrow) {
 603                 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
 604         }
 605         # additional authors : specific
 606         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
 607         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
 608 # modify copyrightdate to keep only the 1st year found
 609         my $temp = $result->{'copyrightdate'};
 610         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 611         if ($1>0) {
 612                 $result->{'copyrightdate'} = $1;
 613         } else { # if no cYYYY, get the 1st date.
 614                 $temp =~ m/(\d\d\d\d)/;
 615                 $result->{'copyrightdate'} = $1;
 616         }
 617 # modify publicationyear to keep only the 1st year found
 618         $temp = $result->{'publicationyear'};
 619         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 620         if ($1>0) {
 621                 $result->{'publicationyear'} = $1;
 622         } else { # if no cYYYY, get the 1st date.
 623                 $temp =~ m/(\d\d\d\d)/;
 624                 $result->{'publicationyear'} = $1;
 625         }
 626         return $result;
 627 }
 628
 629 sub MARCmarc2kohaOneField {
 630
 631 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
 632     my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
 633     #    warn "kohatable / $kohafield / $result / ";
 634     my $res = "";
 635     my $tagfield;
 636     my $subfield;
 637     ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
 638     foreach my $field ( $record->field($tagfield) ) {
 639                 if ($field->tag()<10) {
 640                         if ($result->{$kohafield}) {
 641                                 $result->{$kohafield} .= " | ".$field->data();
 642                         } else {
 643                                 $result->{$kohafield} = $field->data();
 644                         }
 645                 } else {
 646                         if ( $field->subfields ) {
 647                                 my @subfields = $field->subfields();
 648                                 foreach my $subfieldcount ( 0 .. $#subfields ) {
 649                                         if ($subfields[$subfieldcount][0] eq $subfield) {
 650                                                 if ( $result->{$kohafield} ) {
 651                                                         $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
 652                                                 }
 653                                                 else {
 654                                                         $result->{$kohafield} = $subfields[$subfieldcount][1];
 655                                                 }
 656                                         }
 657                                 }
 658                         }
 659                 }
 660     }
 661 #       warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
 662     return $result;
 663 }
 664
 665 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
 666
 667 =over 4
 668
 669 creates a biblio from a MARC::Record.
 670
 671 =back
 672
 673 =cut
 674
 675 sub NEWnewbiblio {
 676     my ( $dbh, $record, $frameworkcode ) = @_;
 677     my $biblionumber;
 678     my $biblioitemnumber;
 679     my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
 680         $olddata->{frameworkcode} = $frameworkcode;
 681     $biblionumber = REALnewbiblio( $dbh, $olddata );
 682         $olddata->{biblionumber} = $biblionumber;
 683         # add biblionumber into the MARC record (it's the ID for zebra)
 684         my ( $tagfield, $tagsubfield ) =
 685                                         MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
 686         # create the field
 687         my $newfield;
 688         if ($tagfield<10) {
 689                 $newfield = MARC::Field->new(
 690                         $tagfield, $biblionumber,
 691                 );
 692         } else {
 693                 $newfield = MARC::Field->new(
 694                         $tagfield, '', '', "$tagsubfield" => $biblionumber,
 695                 );
 696         }
 697         # drop old field (just in case it already exist and create new one...
 698         my $old_field = $record->field($tagfield);
 699         $record->delete_field($old_field);
 700         $record->add_fields($newfield);
 701
 702         #create the marc entry, that stores the rax marc record in Koha 3.0
 703         $olddata->{marc} = $record->as_usmarc();
 704         $olddata->{marcxml} = $record->as_xml();
 705         # and create biblioitem, that's all folks !
 706     $biblioitemnumber = REALnewbiblioitem( $dbh, $olddata );
 707
 708     # search subtiles, addiauthors and subjects
 709     ( $tagfield, $tagsubfield ) =
 710       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
 711     my @addiauthfields = $record->field($tagfield);
 712     foreach my $addiauthfield (@addiauthfields) {
 713         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
 714         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
 715             REALmodaddauthor( $dbh, $biblionumber,
 716                 $addiauthsubfields[$subfieldcount] );
 717         }
 718     }
 719     ( $tagfield, $tagsubfield ) =
 720       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
 721     my @subtitlefields = $record->field($tagfield);
 722     foreach my $subtitlefield (@subtitlefields) {
 723         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
 724         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
 725             REALnewsubtitle( $dbh, $biblionumber,
 726                 $subtitlesubfields[$subfieldcount] );
 727         }
 728     }
 729     ( $tagfield, $tagsubfield ) =
 730       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
 731     my @subj = $record->field($tagfield);
 732     my @subjects;
 733     foreach my $subject (@subj) {
 734         my @subjsubfield = $subject->subfield($tagsubfield);
 735         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
 736             push @subjects, $subjsubfield[$subfieldcount];
 737         }
 738     }
 739     REALmodsubject( $dbh, $biblionumber, 1, @subjects );
 740     return ( $biblionumber, $biblioitemnumber );
 741 }
 742
 743 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
 744
 745 =over 4
 746
 747 modify the framework of a biblio
 748
 749 =back
 750
 751 =cut
 752
 753 sub NEWmodbiblioframework {
 754         my ($dbh,$biblionumber,$frameworkcode) =@_;
 755         my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
 756         $sth->execute($frameworkcode,$biblionumber);
 757         return 1;
 758 }
 759
 760 =head2 NEWmodbiblio($dbh,$MARCrecord,$biblionumber,$frameworkcode);
 761
 762 =over 4
 763
 764 modify a biblio (MARC=ON)
 765
 766 =back
 767
 768 =cut
 769
 770 sub NEWmodbiblio {
 771         my ($dbh,$record,$biblionumber,$frameworkcode) =@_;
 772         $frameworkcode="" unless $frameworkcode;
 773 #       &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
 774         my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
 775
 776         $oldbiblio->{frameworkcode} = $frameworkcode;
 777         #create the marc entry, that stores the rax marc record in Koha 3.0
 778         $oldbiblio->{marc} = $record->as_usmarc();
 779         $oldbiblio->{marcxml} = $record->as_xml();
 780
 781         REALmodbiblio($dbh,$oldbiblio);
 782         REALmodbiblitem($dbh,$oldbiblio);
 783         # now, modify addi authors, subject, addititles.
 784         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
 785         my @addiauthfields = $record->field($tagfield);
 786         foreach my $addiauthfield (@addiauthfields) {
 787                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
 788                 foreach my $subfieldcount (0..$#addiauthsubfields) {
 789                         REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
 790                 }
 791         }
 792         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
 793         my @subtitlefields = $record->field($tagfield);
 794         foreach my $subtitlefield (@subtitlefields) {
 795                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
 796                 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
 797                 # between 2 modifs
 798                 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
 799                 foreach my $subfieldcount (0..$#subtitlesubfields) {
 800                         foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
 801                                 REALnewsubtitle($dbh,$biblionumber,$subtit);
 802                         }
 803                 }
 804         }
 805         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
 806         my @subj = $record->field($tagfield);
 807         my @subjects;
 808         foreach my $subject (@subj) {
 809                 my @subjsubfield = $subject->subfield($tagsubfield);
 810                 foreach my $subfieldcount (0..$#subjsubfield) {
 811                         push @subjects,$subjsubfield[$subfieldcount];
 812                 }
 813         }
 814         REALmodsubject($dbh,$biblionumber,1,@subjects);
 815         return 1;
 816 }
 817
 818 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
 819
 820 =over 4
 821
 822 delete a biblio
 823
 824 =back
 825
 826 =cut
 827
 828 sub NEWdelbiblio {
 829     my ( $dbh, $bibid ) = @_;
 830     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
 831     &REALdelbiblio( $dbh, $biblio );
 832     my $sth =
 833       $dbh->prepare(
 834         "select biblioitemnumber from biblioitems where biblionumber=?");
 835     $sth->execute($biblio);
 836     while ( my ($biblioitemnumber) = $sth->fetchrow ) {
 837         REALdelbiblioitem( $dbh, $biblioitemnumber );
 838     }
 839     &MARCdelbiblio( $dbh, $bibid, 0 );
 840 }
 841
 842 =head2 $itemnumber = NEWnewitem($dbh, $record, $biblionumber, $biblioitemnumber);
 843
 844 =over 4
 845
 846 creates an item from a MARC::Record
 847
 848 =back
 849
 850 =cut
 851
 852 sub NEWnewitem {
 853     my ( $dbh, $record, $biblionumber, $biblioitemnumber ) = @_;
 854
 855     # add item in old-DB
 856         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
 857     my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
 858     # needs old biblionumber and biblioitemnumber
 859     $item->{'biblionumber'} = $biblionumber;
 860     $item->{'biblioitemnumber'}=$biblioitemnumber;
 861         $item->{marc} = $record->as_usmarc();
 862     my ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, $item->{barcode} );
 863         return $itemnumber;
 864 }
 865
 866
 867 =head2 $itemnumber = NEWmoditem($dbh, $record, $biblionumber, $biblioitemnumber,$itemnumber);
 868
 869 =over 4
 870
 871 Modify an item
 872
 873 =back
 874
 875 =cut
 876
 877 sub NEWmoditem {
 878     my ( $dbh, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
 879
 880         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
 881     my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
 882         # add MARC record
 883         $olditem->{marc} = $record->as_usmarc();
 884         $olditem->{biblionumber} = $biblionumber;
 885         $olditem->{biblioitemnumber} = $biblioitemnumber;
 886         # and modify item
 887     REALmoditem( $dbh, $olditem );
 888 }
 889
 890
 891 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
 892
 893 =over 4
 894
 895 delete an item
 896
 897 =back
 898
 899 =cut
 900
 901 sub NEWdelitem {
 902     my ( $dbh, $bibid, $itemnumber ) = @_;
 903     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
 904     &REALdelitem( $dbh, $itemnumber );
 905     &MARCdelitem( $dbh, $bibid, $itemnumber );
 906 }
 907
 908
 909 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
 910
 911 =over 4
 912
 913 adds a record in biblio table. Datas are in the hash $biblio.
 914
 915 =back
 916
 917 =cut
 918
 919 sub REALnewbiblio {
 920     my ( $dbh, $biblio ) = @_;
 921
 922         $dbh->do('lock tables biblio WRITE');
 923     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
 924     $sth->execute;
 925     my $data   = $sth->fetchrow_arrayref;
 926     my $bibnum = $$data[0] + 1;
 927     my $series = 0;
 928
 929     if ( $biblio->{'seriestitle'} ) { $series = 1 }
 930     $sth->finish;
 931     $sth =
 932       $dbh->prepare("insert into biblio set     biblionumber=?, title=?,                author=?,       copyrightdate=?,
 933                                                                                         serial=?,               seriestitle=?,  notes=?,        abstract=?,
 934                                                                                         unititle=?"
 935     );
 936     $sth->execute(
 937         $bibnum,             $biblio->{'title'},
 938         $biblio->{'author'}, $biblio->{'copyrightdate'},
 939         $biblio->{'serial'},             $biblio->{'seriestitle'},
 940         $biblio->{'notes'},  $biblio->{'abstract'},
 941                 $biblio->{'unititle'}
 942     );
 943
 944     $sth->finish;
 945         $dbh->do('unlock tables');
 946     return ($bibnum);
 947 }
 948
 949 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
 950
 951 =over 4
 952
 953 modify a record in biblio table. Datas are in the hash $biblio.
 954
 955 =back
 956
 957 =cut
 958
 959 sub REALmodbiblio {
 960     my ( $dbh, $biblio ) = @_;
 961     my $sth = $dbh->prepare("Update biblio set  title=?,                author=?,       abstract=?,     copyrightdate=?,
 962                                                                                                 seriestitle=?,  serial=?,       unititle=?,     notes=?,        frameworkcode=?
 963                                                                                         where biblionumber = ?"
 964     );
 965     $sth->execute(
 966                 $biblio->{'title'},       $biblio->{'author'},
 967                 $biblio->{'abstract'},    $biblio->{'copyrightdate'},
 968                 $biblio->{'seriestitle'}, $biblio->{'serial'},
 969                 $biblio->{'unititle'},    $biblio->{'notes'},
 970                 $biblio->{frameworkcode},
 971                 $biblio->{'biblionumber'}
 972     );
 973         $sth->finish;
 974         return ( $biblio->{'biblionumber'} );
 975 }    # sub modbiblio
 976
 977 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
 978
 979 =over 4
 980
 981 modify subtitles in bibliosubtitle table.
 982
 983 =back
 984
 985 =cut
 986
 987 sub REALmodsubtitle {
 988     my ( $dbh, $bibnum, $subtitle ) = @_;
 989     my $sth =
 990       $dbh->prepare(
 991         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
 992     $sth->execute( $subtitle, $bibnum );
 993     $sth->finish;
 994 }    # sub modsubtitle
 995
 996 =head2 REALmodaddauthor($dbh,$bibnum,$author);
 997
 998 =over 4
 999
1000 adds or modify additional authors
1001 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1002
1003 =back
1004
1005 =cut
1006
1007 sub REALmodaddauthor {
1008     my ( $dbh, $bibnum, @authors ) = @_;
1009
1010     #    my $dbh   = C4Connect;
1011     my $sth =
1012       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1013
1014     $sth->execute($bibnum);
1015     $sth->finish;
1016     foreach my $author (@authors) {
1017         if ( $author ne '' ) {
1018             $sth =
1019               $dbh->prepare(
1020                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1021             );
1022
1023             $sth->execute( $author, $bibnum );
1024
1025             $sth->finish;
1026         }    # if
1027     }
1028 }    # sub modaddauthor
1029
1030 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1031
1032 =over 4
1033
1034 modify/adds subjects
1035
1036 =back
1037
1038 =cut
1039 sub REALmodsubject {
1040     my ( $dbh, $bibnum, $force, @subject ) = @_;
1041
1042     #  my $dbh   = C4Connect;
1043     my $count = @subject;
1044     my $error;
1045     for ( my $i = 0 ; $i < $count ; $i++ ) {
1046         $subject[$i] =~ s/^ //g;
1047         $subject[$i] =~ s/ $//g;
1048         my $sth =
1049           $dbh->prepare(
1050 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1051         );
1052         $sth->execute( $subject[$i] );
1053
1054         if ( my $data = $sth->fetchrow_hashref ) {
1055         }
1056         else {
1057             if ( $force eq $subject[$i] || $force == 1 ) {
1058
1059                 # subject not in aut, chosen to force anway
1060                 # so insert into cataloguentry so its in auth file
1061                 my $sth2 =
1062                   $dbh->prepare(
1063 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1064                 );
1065
1066                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1067                 $sth2->finish;
1068             }
1069             else {
1070                 $error =
1071                   "$subject[$i]\n does not exist in the subject authority file";
1072                 my $sth2 =
1073                   $dbh->prepare(
1074 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1075                 );
1076                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1077                     "% $subject[$i]" );
1078                 while ( my $data = $sth2->fetchrow_hashref ) {
1079                     $error .= "<br>$data->{'catalogueentry'}";
1080                 }    # while
1081                 $sth2->finish;
1082             }    # else
1083         }    # else
1084         $sth->finish;
1085     }    # else
1086     if ( $error eq '' ) {
1087         my $sth =
1088           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1089         $sth->execute($bibnum);
1090         $sth->finish;
1091         $sth =
1092           $dbh->prepare(
1093             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1094         my $query;
1095         foreach $query (@subject) {
1096             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1097         }    # foreach
1098         $sth->finish;
1099     }    # if
1100
1101     #  $dbh->disconnect;
1102     return ($error);
1103 }    # sub modsubject
1104
1105 =head2 REALmodbiblitem($dbh, $biblioitem);
1106
1107 =over 4
1108
1109 modify a biblioitem
1110
1111 =back
1112
1113 =cut
1114 sub REALmodbiblitem {
1115     my ( $dbh, $biblioitem ) = @_;
1116     my $query;
1117
1118     my $sth = $dbh->prepare("update biblioitems set     itemtype=?,                     url=?,                          isbn=?, issn=?,
1119                                                                                 publishercode=?,        publicationyear=?,      classification=?,       dewey=?,
1120                                                                                 subclass=?,                     illus=?,                        pages=?,                        volumeddesc=?,
1121                                                                                 notes=?,                        size=?,                         place=?,                        marc=?,
1122                                                                                 marcxml=?
1123                                                         where biblioitemnumber=?");
1124         $sth->execute(  $biblioitem->{itemtype},                $biblioitem->{url},             $biblioitem->{isbn},    $biblioitem->{issn},
1125                                 $biblioitem->{publishercode},   $biblioitem->{publicationyear}, $biblioitem->{classification},  $biblioitem->{dewey},
1126                                 $biblioitem->{subclass},                $biblioitem->{illus},           $biblioitem->{pages},   $biblioitem->{volumeddesc},
1127                                 $biblioitem->{bnotes},                  $biblioitem->{size},            $biblioitem->{place},   $biblioitem->{marc},
1128                                         $biblioitem->{marcxml},                 $biblioitem->{biblioitemnumber});
1129 #       warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1130 }    # sub modbibitem
1131
1132 =head2 REALnewbiblioitem($dbh,$biblioitem);
1133
1134 =over 4
1135
1136 adds a biblioitem ($biblioitem is a hash with the values)
1137
1138 =back
1139
1140 =cut
1141
1142 sub REALnewbiblioitem {
1143         my ( $dbh, $biblioitem ) = @_;
1144
1145         $dbh->do("lock tables biblioitems WRITE, biblio WRITE");
1146         my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1147         my $data;
1148         my $biblioitemnumber;
1149
1150         $sth->execute;
1151         $data       = $sth->fetchrow_arrayref;
1152         $biblioitemnumber = $$data[0] + 1;
1153
1154         # Insert biblioitemnumber in MARC record, we need it to manage items later...
1155         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1156         my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1157         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1158         my $field=$record->field($biblioitemnumberfield);
1159         $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1160         $biblioitem->{marc} = $record->as_usmarc();
1161         $biblioitem->{marcxml} = $record->as_xml();
1162
1163         $sth = $dbh->prepare( "insert into biblioitems set
1164                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1165                                                                         volume           = ?,                   number           = ?,
1166                                                                         classification  = ?,                    itemtype         = ?,
1167                                                                         url              = ?,                           isbn             = ?,
1168                                                                         issn             = ?,                           dewey            = ?,
1169                                                                         subclass         = ?,                           publicationyear  = ?,
1170                                                                         publishercode    = ?,           volumedate       = ?,
1171                                                                         volumeddesc      = ?,           illus            = ?,
1172                                                                         pages            = ?,                           notes            = ?,
1173                                                                         size             = ?,                           lccn             = ?,
1174                                                                         marc             = ?,                           place            = ?,
1175                                                                         marcxml          = ?"
1176         );
1177         $sth->execute(
1178                 $biblioitemnumber,               $biblioitem->{'biblionumber'},
1179                 $biblioitem->{'volume'},         $biblioitem->{'number'},
1180                 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1181                 $biblioitem->{'url'},            $biblioitem->{'isbn'},
1182                 $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1183                 $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1184                 $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1185                 $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1186                 $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1187                 $biblioitem->{'size'},           $biblioitem->{'lccn'},
1188                 $biblioitem->{'marc'},           $biblioitem->{'place'},
1189                 $biblioitem->{marcxml},
1190         );
1191         $dbh->do("unlock tables");
1192         return ($biblioitemnumber);
1193 }
1194
1195 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1196
1197 =over 4
1198
1199 create a new subtitle
1200
1201 =back
1202
1203 =cut
1204 sub REALnewsubtitle {
1205     my ( $dbh, $bibnum, $subtitle ) = @_;
1206     my $sth =
1207       $dbh->prepare(
1208         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1209     $sth->execute( $bibnum, $subtitle ) if $subtitle;
1210     $sth->finish;
1211 }
1212
1213 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$item,$barcode);
1214
1215 =over 4
1216
1217 create a item. $item is a hash and $barcode the barcode.
1218
1219 =back
1220
1221 =cut
1222
1223 sub REALnewitems {
1224     my ( $dbh, $item, $barcode ) = @_;
1225
1226 #       warn "OLDNEWITEMS";
1227
1228         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1229     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1230     my $data;
1231     my $itemnumber;
1232     my $error = "";
1233     $sth->execute;
1234     $data       = $sth->fetchrow_hashref;
1235     $itemnumber = $data->{'max(itemnumber)'} + 1;
1236
1237 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1238     if ( $item->{'loan'} ) {
1239         $item->{'notforloan'} = $item->{'loan'};
1240     }
1241
1242     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1243     if ( $item->{'dateaccessioned'} ) {
1244         $sth = $dbh->prepare( "Insert into items set
1245                                                         itemnumber           = ?,                       biblionumber         = ?,
1246                                                         multivolumepart      = ?,
1247                                                         biblioitemnumber     = ?,                       barcode              = ?,
1248                                                         booksellerid         = ?,                       dateaccessioned      = ?,
1249                                                         homebranch           = ?,                       holdingbranch        = ?,
1250                                                         price                = ?,                       replacementprice     = ?,
1251                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1252                                                         multivolume                     = ?,                    stack                           = ?,
1253                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1254                                                         paidfor                         = ?,                    itemnotes            = ?,
1255                                                         itemcallnumber  =?,                                                     notforloan = ?,
1256                                                         location = ?
1257                                                         "
1258         );
1259         $sth->execute(
1260                         $itemnumber,                            $item->{'biblionumber'},
1261                         $item->{'multivolumepart'},
1262                         $item->{'biblioitemnumber'},$barcode,
1263                         $item->{'booksellerid'},        $item->{'dateaccessioned'},
1264                         $item->{'homebranch'},          $item->{'holdingbranch'},
1265                         $item->{'price'},                       $item->{'replacementprice'},
1266                         $item->{multivolume},           $item->{stack},
1267                         $item->{itemlost},                      $item->{wthdrawn},
1268                         $item->{paidfor},                       $item->{'itemnotes'},
1269                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1270                         $item->{'location'}
1271         );
1272                 if ( defined $sth->errstr ) {
1273                         $error .= $sth->errstr;
1274                 }
1275     }
1276     else {
1277         $sth = $dbh->prepare( "Insert into items set
1278                                                         itemnumber           = ?,                       biblionumber         = ?,
1279                                                         multivolumepart      = ?,
1280                                                         biblioitemnumber     = ?,                       barcode              = ?,
1281                                                         booksellerid         = ?,                       dateaccessioned      = NOW(),
1282                                                         homebranch           = ?,                       holdingbranch        = ?,
1283                                                         price                = ?,                       replacementprice     = ?,
1284                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1285                                                         multivolume                     = ?,                    stack                           = ?,
1286                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1287                                                         paidfor                         = ?,                    itemnotes            = ?,
1288                                                         itemcallnumber  =?,                                                     notforloan = ?,
1289                                                         location = ?
1290                                                         "
1291         );
1292         $sth->execute(
1293                         $itemnumber,                            $item->{'biblionumber'},
1294                         $item->{'multivolumepart'},
1295                         $item->{'biblioitemnumber'},$barcode,
1296                         $item->{'booksellerid'},
1297                         $item->{'homebranch'},          $item->{'holdingbranch'},
1298                         $item->{'price'},                       $item->{'replacementprice'},
1299                         $item->{multivolume},           $item->{stack},
1300                         $item->{itemlost},                      $item->{wthdrawn},
1301                         $item->{paidfor},                       $item->{'itemnotes'},
1302                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1303                         $item->{'location'}
1304         );
1305                 if ( defined $sth->errstr ) {
1306                         $error .= $sth->errstr;
1307                 }
1308     }
1309         # item stored, now, deal with the marc part...
1310         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1311                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1312                                                                         biblio.biblionumber=?");
1313         $sth->execute($item->{biblionumber});
1314     if ( defined $sth->errstr ) {
1315         $error .= $sth->errstr;
1316     }
1317         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1318         warn "ERROR IN OLDnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1319         my $record = MARC::File::USMARC::decode($rawmarc);
1320         # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1321         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1322         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1323         my $itemfield = $itemrecord->field($itemnumberfield);
1324         $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1325         $record->insert_grouped_field($itemfield);
1326         # save the record into biblioitem
1327         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1328         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1329     if ( defined $sth->errstr ) {
1330         $error .= $sth->errstr;
1331     }
1332         $dbh->do('unlock tables');
1333     return ( $itemnumber, $error );
1334 }
1335
1336 =head2 REALmoditem($dbh,$item);
1337
1338 =over 4
1339
1340 modify item
1341
1342 =back
1343
1344 =cut
1345
1346 sub REALmoditem {
1347     my ( $dbh, $item ) = @_;
1348         my $error;
1349         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1350     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1351     my $query = "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1352     my @bind = (
1353         $item->{'barcode'},                     $item->{'notes'},
1354         $item->{'itemcallnumber'},      $item->{'notforloan'},
1355         $item->{'location'},            $item->{multivolumepart},
1356                 $item->{multivolume},           $item->{stack},
1357                 $item->{wthdrawn},
1358     );
1359     if ( $item->{'lost'} ne '' ) {
1360         $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1361                                                         itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1362                                                         location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1363         @bind = (
1364             $item->{'bibitemnum'},     $item->{'barcode'},
1365             $item->{'notes'},          $item->{'homebranch'},
1366             $item->{'lost'},           $item->{'wthdrawn'},
1367             $item->{'itemcallnumber'}, $item->{'notforloan'},
1368             $item->{'location'},                $item->{multivolumepart},
1369                         $item->{multivolume},           $item->{stack},
1370                         $item->{wthdrawn},
1371         );
1372                 if ($item->{homebranch}) {
1373                         $query.=",homebranch=?";
1374                         push @bind, $item->{homebranch};
1375                 }
1376                 if ($item->{holdingbranch}) {
1377                         $query.=",holdingbranch=?";
1378                         push @bind, $item->{holdingbranch};
1379                 }
1380     }
1381         $query.=" where itemnumber=?";
1382         push @bind,$item->{'itemnum'};
1383    if ( $item->{'replacement'} ne '' ) {
1384         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1385     }
1386     my $sth = $dbh->prepare($query);
1387     $sth->execute(@bind);
1388
1389         # item stored, now, deal with the marc part...
1390         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1391                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1392                                                                         biblio.biblionumber=? and
1393                                                                         biblioitems.biblioitemnumber=?");
1394         $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1395     if ( defined $sth->errstr ) {
1396         $error .= $sth->errstr;
1397     }
1398         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1399         warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1400         my $record = MARC::File::USMARC::decode($rawmarc);
1401         # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1402         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1403         # prepare the new item record
1404         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1405         my $itemfield = $itemrecord->field($itemnumberfield);
1406         $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1407         # parse all fields fields from the complete record
1408         foreach ($record->field($itemnumberfield)) {
1409                 # when the previous field is found, replace by the new one
1410                 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1411                         $_->replace_with($itemfield);
1412                 }
1413         }
1414 #       $record->insert_grouped_field($itemfield);
1415         # save the record into biblioitem
1416         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1417         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1418     if ( defined $sth->errstr ) {
1419         $error .= $sth->errstr;
1420     }
1421         $dbh->do('unlock tables');
1422
1423     #  $dbh->disconnect;
1424 }
1425
1426 =head2 REALdelitem($dbh,$itemnum);
1427
1428 =over 4
1429
1430 delete item
1431
1432 =back
1433
1434 =cut
1435
1436 sub REALdelitem {
1437     my ( $dbh, $itemnum ) = @_;
1438
1439     #  my $dbh=C4Connect;
1440     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1441     $sth->execute($itemnum);
1442     my $data = $sth->fetchrow_hashref;
1443     $sth->finish;
1444     my $query = "Insert into deleteditems set ";
1445     my @bind  = ();
1446     foreach my $temp ( keys %$data ) {
1447         $query .= "$temp = ?,";
1448         push ( @bind, $data->{$temp} );
1449     }
1450     $query =~ s/\,$//;
1451
1452     #  print $query;
1453     $sth = $dbh->prepare($query);
1454     $sth->execute(@bind);
1455     $sth->finish;
1456     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1457     $sth->execute($itemnum);
1458     $sth->finish;
1459
1460     #  $dbh->disconnect;
1461 }
1462
1463 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1464
1465 =over 4
1466
1467 deletes a biblioitem
1468 NOTE : not standard sub name. Should be REALdelbiblioitem()
1469
1470 =back
1471
1472 =cut
1473
1474 sub REALdelbiblioitem {
1475     my ( $dbh, $biblioitemnumber ) = @_;
1476
1477     #    my $dbh   = C4Connect;
1478     my $sth = $dbh->prepare( "Select * from biblioitems
1479 where biblioitemnumber = ?"
1480     );
1481     my $results;
1482
1483     $sth->execute($biblioitemnumber);
1484
1485     if ( $results = $sth->fetchrow_hashref ) {
1486         $sth->finish;
1487         $sth =
1488           $dbh->prepare(
1489 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1490                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1491                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1492         );
1493
1494         $sth->execute(
1495             $results->{biblioitemnumber}, $results->{biblionumber},
1496             $results->{volume},           $results->{number},
1497             $results->{classification},   $results->{itemtype},
1498             $results->{isbn},             $results->{issn},
1499             $results->{dewey},            $results->{subclass},
1500             $results->{publicationyear},  $results->{publishercode},
1501             $results->{volumedate},       $results->{volumeddesc},
1502             $results->{timestamp},        $results->{illus},
1503             $results->{pages},            $results->{notes},
1504             $results->{size},             $results->{url},
1505             $results->{lccn}
1506         );
1507         my $sth2 =
1508           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1509         $sth2->execute($biblioitemnumber);
1510         $sth2->finish();
1511     }    # if
1512     $sth->finish;
1513
1514     # Now delete all the items attached to the biblioitem
1515     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1516     $sth->execute($biblioitemnumber);
1517     my @results;
1518     while ( my $data = $sth->fetchrow_hashref ) {
1519         my $query = "Insert into deleteditems set ";
1520         my @bind  = ();
1521         foreach my $temp ( keys %$data ) {
1522             $query .= "$temp = ?,";
1523             push ( @bind, $data->{$temp} );
1524         }
1525         $query =~ s/\,$//;
1526         my $sth2 = $dbh->prepare($query);
1527         $sth2->execute(@bind);
1528     }    # while
1529     $sth->finish;
1530     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1531     $sth->execute($biblioitemnumber);
1532     $sth->finish();
1533
1534     #    $dbh->disconnect;
1535 }    # sub deletebiblioitem
1536
1537 =head2 REALdelbiblio($dbh,$biblio);
1538
1539 =over 4
1540
1541 delete a biblio
1542
1543 =back
1544
1545 =cut
1546
1547 sub REALdelbiblio {
1548     my ( $dbh, $biblio ) = @_;
1549     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1550     $sth->execute($biblio);
1551     if ( my $data = $sth->fetchrow_hashref ) {
1552         $sth->finish;
1553         my $query = "Insert into deletedbiblio set ";
1554         my @bind  = ();
1555         foreach my $temp ( keys %$data ) {
1556             $query .= "$temp = ?,";
1557             push ( @bind, $data->{$temp} );
1558         }
1559
1560         #replacing the last , by ",?)"
1561         $query =~ s/\,$//;
1562         $sth = $dbh->prepare($query);
1563         $sth->execute(@bind);
1564         $sth->finish;
1565         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1566         $sth->execute($biblio);
1567         $sth->finish;
1568     }
1569     $sth->finish;
1570 }
1571
1572 =head2 $number = itemcount($biblio);
1573
1574 =over 4
1575
1576 returns the number of items attached to a biblio
1577
1578 =back
1579
1580 =cut
1581
1582 sub itemcount {
1583     my ($biblio) = @_;
1584     my $dbh = C4::Context->dbh;
1585
1586     #  print $query;
1587     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1588     $sth->execute($biblio);
1589     my $data = $sth->fetchrow_hashref;
1590     $sth->finish;
1591     return ( $data->{'count(*)'} );
1592 }
1593
1594 =head2 $biblionumber = newbiblio($biblio);
1595
1596 =over 4
1597
1598 create a biblio. The parameter is a hash
1599
1600 =back
1601
1602 =cut
1603
1604 sub newbiblio {
1605     my ($biblio) = @_;
1606     my $dbh    = C4::Context->dbh;
1607     my $bibnum = REALnewbiblio( $dbh, $biblio );
1608     # finds new (MARC bibid
1609     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1610     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1611     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1612     return ($bibnum);
1613 }
1614
1615 =head2   $biblionumber = &modbiblio($biblio);
1616
1617 =over 4
1618
1619 Update a biblio record.
1620
1621 C<$biblio> is a reference-to-hash whose keys are the fields in the
1622 biblio table in the Koha database. All fields must be present, not
1623 just the ones you wish to change.
1624
1625 C<&modbiblio> updates the record defined by
1626 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1627
1628 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1629 successful or not.
1630
1631 =back
1632
1633 =cut
1634
1635 sub modbiblio {
1636         my ($biblio) = @_;
1637         my $dbh  = C4::Context->dbh;
1638         my $biblionumber=REALmodbiblio($dbh,$biblio);
1639         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1640         # finds new (MARC bibid
1641         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1642         MARCmodbiblio($dbh,$bibid,$record,"",0);
1643         return($biblionumber);
1644 } # sub modbiblio
1645
1646 =head2   &modsubtitle($biblionumber, $subtitle);
1647
1648 =over 4
1649
1650 Sets the subtitle of a book.
1651
1652 C<$biblionumber> is the biblionumber of the book to modify.
1653
1654 C<$subtitle> is the new subtitle.
1655
1656 =back
1657
1658 =cut
1659
1660 sub modsubtitle {
1661     my ( $bibnum, $subtitle ) = @_;
1662     my $dbh = C4::Context->dbh;
1663     &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1664 }    # sub modsubtitle
1665
1666 =head2 &modaddauthor($biblionumber, $author);
1667
1668 =over 4
1669
1670 Replaces all additional authors for the book with biblio number
1671 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1672 C<&modaddauthor> deletes all additional authors.
1673
1674 =back
1675
1676 =cut
1677
1678 sub modaddauthor {
1679     my ( $bibnum, @authors ) = @_;
1680     my $dbh = C4::Context->dbh;
1681     &REALmodaddauthor( $dbh, $bibnum, @authors );
1682 }    # sub modaddauthor
1683
1684 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1685
1686 =over 4
1687
1688 $force - a subject to force
1689 $error - Error message, or undef if successful.
1690
1691 =back
1692
1693 =cut
1694
1695 sub modsubject {
1696     my ( $bibnum, $force, @subject ) = @_;
1697     my $dbh = C4::Context->dbh;
1698     my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1699     if ($error eq ''){
1700                 # When MARC is off, ensures that the MARC biblio table gets updated with new
1701                 # subjects, of course, it deletes the biblio in marc, and then recreates.
1702                 # This check is to ensure that no MARC data exists to lose.
1703                 if (C4::Context->preference("MARC") eq '0'){
1704                         my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1705                         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1706                         &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1707                 }
1708         }
1709         return ($error);
1710 }    # sub modsubject
1711
1712 =head2 modbibitem($biblioitem);
1713
1714 =over 4
1715
1716 modify a biblioitem. The parameter is a hash
1717
1718 =back
1719
1720 =cut
1721
1722 sub modbibitem {
1723     my ($biblioitem) = @_;
1724     my $dbh = C4::Context->dbh;
1725     &REALmodbiblitem( $dbh, $biblioitem );
1726 }    # sub modbibitem
1727
1728 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1729
1730 =over 4
1731
1732 create a biblioitem, the parameter is a hash
1733
1734 =back
1735
1736 =cut
1737
1738 sub newbiblioitem {
1739     my ($biblioitem) = @_;
1740     my $dbh        = C4::Context->dbh;
1741     my $bibitemnum = &REALnewbiblioitem( $dbh, $biblioitem );
1742
1743     my $MARCbiblio =
1744       MARCkoha2marcBiblio( $dbh, 0, $bibitemnum )
1745       ; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record
1746     my $bibid =
1747       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh,
1748         $biblioitem->{biblionumber} );
1749     &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, '',$bibid );
1750     return ($bibitemnum);
1751 }
1752
1753 =head2 newsubtitle($biblionumber,$subtitle);
1754
1755 =over 4
1756
1757 insert a subtitle for $biblionumber biblio
1758
1759 =back
1760
1761 =cut
1762
1763
1764 sub newsubtitle {
1765     my ( $bibnum, $subtitle ) = @_;
1766     my $dbh = C4::Context->dbh;
1767     &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1768 }
1769
1770 =head2 $errors = newitems($item, @barcodes);
1771
1772 =over 4
1773
1774 insert items ($item is a hash)
1775
1776 =back
1777
1778 =cut
1779
1780
1781 sub newitems {
1782     my ( $item, @barcodes ) = @_;
1783     my $dbh = C4::Context->dbh;
1784     my $errors;
1785     my $itemnumber;
1786     my $error;
1787     foreach my $barcode (@barcodes) {
1788         ( $itemnumber, $error ) = &REALnewitems( $dbh, $item, uc($barcode) );
1789         $errors .= $error;
1790         my $MARCitem =
1791           &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
1792         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1793     }
1794     return ($errors);
1795 }
1796
1797 =head2 moditem($item);
1798
1799 =over 4
1800
1801 modify an item ($item is a hash with all item informations)
1802
1803 =back
1804
1805 =cut
1806
1807
1808 sub moditem {
1809     my ($item) = @_;
1810     my $dbh = C4::Context->dbh;
1811     &REALmoditem( $dbh, $item );
1812     my $MARCitem =
1813       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1814     my $bibid =
1815       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1816     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1817 }
1818
1819 =head2 $error = checkitems($count,@barcodes);
1820
1821 =over 4
1822
1823 check for each @barcode entry that the barcode is not a duplicate
1824
1825 =back
1826
1827 =cut
1828
1829 sub checkitems {
1830     my ( $count, @barcodes ) = @_;
1831     my $dbh = C4::Context->dbh;
1832     my $error;
1833     my $sth = $dbh->prepare("Select * from items where barcode=?");
1834     for ( my $i = 0 ; $i < $count ; $i++ ) {
1835         $barcodes[$i] = uc $barcodes[$i];
1836         $sth->execute( $barcodes[$i] );
1837         if ( my $data = $sth->fetchrow_hashref ) {
1838             $error .= " Duplicate Barcode: $barcodes[$i]";
1839         }
1840     }
1841     $sth->finish;
1842     return ($error);
1843 }
1844
1845 =head2 $delitem($itemnum);
1846
1847 =over 4
1848
1849 delete item $itemnum being the item number to delete
1850
1851 =back
1852
1853 =cut
1854
1855 sub delitem {
1856     my ($itemnum) = @_;
1857     my $dbh = C4::Context->dbh;
1858     &REALdelitem( $dbh, $itemnum );
1859 }
1860
1861 =head2 deletebiblioitem($biblioitemnumber);
1862
1863 =over 4
1864
1865 delete the biblioitem $biblioitemnumber
1866
1867 =back
1868
1869 =cut
1870
1871 sub deletebiblioitem {
1872     my ($biblioitemnumber) = @_;
1873     my $dbh = C4::Context->dbh;
1874     &REALdelbiblioitem( $dbh, $biblioitemnumber );
1875 }    # sub deletebiblioitem
1876
1877 =head2 delbiblio($biblionumber)
1878
1879 =over 4
1880
1881 delete biblio $biblionumber
1882
1883 =back
1884
1885 =cut
1886
1887 sub delbiblio {
1888     my ($biblio) = @_;
1889     my $dbh = C4::Context->dbh;
1890     &REALdelbiblio( $dbh, $biblio );
1891     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
1892     &MARCdelbiblio( $dbh, $bibid, 0 );
1893 }
1894
1895 =head2 ($count,@results) = getbiblio($biblionumber);
1896
1897 =over 4
1898
1899 return an array with hash of biblios.
1900
1901 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
1902
1903 =back
1904
1905 =cut
1906
1907 sub getbiblio {
1908     my ($biblionumber) = @_;
1909     my $dbh = C4::Context->dbh;
1910     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1911
1912     # || die "Cannot prepare $query\n" . $dbh->errstr;
1913     my $count = 0;
1914     my @results;
1915
1916     $sth->execute($biblionumber);
1917
1918     # || die "Cannot execute $query\n" . $sth->errstr;
1919     while ( my $data = $sth->fetchrow_hashref ) {
1920         $results[$count] = $data;
1921         $count++;
1922     }    # while
1923
1924     $sth->finish;
1925     return ( $count, @results );
1926 }    # sub getbiblio
1927
1928 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
1929
1930 =over 4
1931
1932 return an array with hash of biblioitemss.
1933
1934 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
1935
1936 =back
1937
1938 =cut
1939
1940 sub getbiblioitem {
1941     my ($biblioitemnum) = @_;
1942     my $dbh = C4::Context->dbh;
1943     my $sth = $dbh->prepare( "Select * from biblioitems where
1944 biblioitemnumber = ?"
1945     );
1946     my $count = 0;
1947     my @results;
1948
1949     $sth->execute($biblioitemnum);
1950
1951     while ( my $data = $sth->fetchrow_hashref ) {
1952         $results[$count] = $data;
1953         $count++;
1954     }    # while
1955
1956     $sth->finish;
1957     return ( $count, @results );
1958 }    # sub getbiblioitem
1959
1960 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
1961
1962 =over 4
1963
1964 return an array with hash of biblioitems for the given biblionumber.
1965
1966 =back
1967
1968 =cut
1969
1970 sub getbiblioitembybiblionumber {
1971     my ($biblionumber) = @_;
1972     my $dbh = C4::Context->dbh;
1973     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1974     my $count = 0;
1975     my @results;
1976
1977     $sth->execute($biblionumber);
1978
1979     while ( my $data = $sth->fetchrow_hashref ) {
1980         $results[$count] = $data;
1981         $count++;
1982     }    # while
1983
1984     $sth->finish;
1985     return ( $count, @results );
1986 }    # sub
1987
1988 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
1989
1990 =over 4
1991
1992 returns an array with hash of items
1993
1994 =back
1995
1996 =cut
1997
1998 sub getitemsbybiblioitem {
1999     my ($biblioitemnum) = @_;
2000     my $dbh = C4::Context->dbh;
2001     my $sth = $dbh->prepare( "Select * from items, biblio where
2002 biblio.biblionumber = items.biblionumber and biblioitemnumber
2003 = ?"
2004     );
2005
2006     # || die "Cannot prepare $query\n" . $dbh->errstr;
2007     my $count = 0;
2008     my @results;
2009
2010     $sth->execute($biblioitemnum);
2011
2012     # || die "Cannot execute $query\n" . $sth->errstr;
2013     while ( my $data = $sth->fetchrow_hashref ) {
2014         $results[$count] = $data;
2015         $count++;
2016     }    # while
2017
2018     $sth->finish;
2019     return ( $count, @results );
2020 }    # sub getitemsbybiblioitem
2021
2022 sub char_decode {
2023
2024     # converts ISO 5426 coded string to ISO 8859-1
2025     # sloppy code : should be improved in next issue
2026     my ( $string, $encoding ) = @_;
2027     $_ = $string;
2028
2029     #   $encoding = C4::Context->preference("marcflavour") unless $encoding;
2030     if ( $encoding eq "UNIMARC" ) {
2031 #         s/\xe1/Æ/gm;
2032         s/\xe2/Ð/gm;
2033         s/\xe9/Ø/gm;
2034         s/\xec/þ/gm;
2035         s/\xf1/æ/gm;
2036         s/\xf3/ð/gm;
2037         s/\xf9/ø/gm;
2038         s/\xfb/ß/gm;
2039         s/\xc1\x61/à/gm;
2040         s/\xc1\x65/è/gm;
2041         s/\xc1\x69/ì/gm;
2042         s/\xc1\x6f/ò/gm;
2043         s/\xc1\x75/ù/gm;
2044         s/\xc1\x41/À/gm;
2045         s/\xc1\x45/È/gm;
2046         s/\xc1\x49/Ì/gm;
2047         s/\xc1\x4f/Ò/gm;
2048         s/\xc1\x55/Ù/gm;
2049         s/\xc2\x41/Á/gm;
2050         s/\xc2\x45/É/gm;
2051         s/\xc2\x49/Í/gm;
2052         s/\xc2\x4f/Ó/gm;
2053         s/\xc2\x55/Ú/gm;
2054         s/\xc2\x59/Ý/gm;
2055         s/\xc2\x61/á/gm;
2056         s/\xc2\x65/é/gm;
2057         s/\xc2\x69/í/gm;
2058         s/\xc2\x6f/ó/gm;
2059         s/\xc2\x75/ú/gm;
2060         s/\xc2\x79/ý/gm;
2061         s/\xc3\x41/Â/gm;
2062         s/\xc3\x45/Ê/gm;
2063         s/\xc3\x49/Î/gm;
2064         s/\xc3\x4f/Ô/gm;
2065         s/\xc3\x55/Û/gm;
2066         s/\xc3\x61/â/gm;
2067         s/\xc3\x65/ê/gm;
2068         s/\xc3\x69/î/gm;
2069         s/\xc3\x6f/ô/gm;
2070         s/\xc3\x75/û/gm;
2071         s/\xc4\x41/Ã/gm;
2072         s/\xc4\x4e/Ñ/gm;
2073         s/\xc4\x4f/Õ/gm;
2074         s/\xc4\x61/ã/gm;
2075         s/\xc4\x6e/ñ/gm;
2076         s/\xc4\x6f/õ/gm;
2077         s/\xc8\x41/Ä/gm;
2078         s/\xc8\x45/Ë/gm;
2079         s/\xc8\x49/Ï/gm;
2080         s/\xc8\x61/ä/gm;
2081         s/\xc8\x65/ë/gm;
2082         s/\xc8\x69/ï/gm;
2083         s/\xc8\x6F/ö/gm;
2084         s/\xc8\x75/ü/gm;
2085         s/\xc8\x76/ÿ/gm;
2086         s/\xc9\x41/Ä/gm;
2087         s/\xc9\x45/Ë/gm;
2088         s/\xc9\x49/Ï/gm;
2089         s/\xc9\x4f/Ö/gm;
2090         s/\xc9\x55/Ü/gm;
2091         s/\xc9\x61/ä/gm;
2092         s/\xc9\x6f/ö/gm;
2093         s/\xc9\x75/ü/gm;
2094         s/\xca\x41/Å/gm;
2095         s/\xca\x61/å/gm;
2096         s/\xd0\x43/Ç/gm;
2097         s/\xd0\x63/ç/gm;
2098
2099         # this handles non-sorting blocks (if implementation requires this)
2100         $string = nsb_clean($_);
2101     }
2102     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2103         if (/[\xc1-\xff]/) {
2104             s/\xe1\x61/à/gm;
2105             s/\xe1\x65/è/gm;
2106             s/\xe1\x69/ì/gm;
2107             s/\xe1\x6f/ò/gm;
2108             s/\xe1\x75/ù/gm;
2109             s/\xe1\x41/À/gm;
2110             s/\xe1\x45/È/gm;
2111             s/\xe1\x49/Ì/gm;
2112             s/\xe1\x4f/Ò/gm;
2113             s/\xe1\x55/Ù/gm;
2114             s/\xe2\x41/Á/gm;
2115             s/\xe2\x45/É/gm;
2116             s/\xe2\x49/Í/gm;
2117             s/\xe2\x4f/Ó/gm;
2118             s/\xe2\x55/Ú/gm;
2119             s/\xe2\x59/Ý/gm;
2120             s/\xe2\x61/á/gm;
2121             s/\xe2\x65/é/gm;
2122             s/\xe2\x69/í/gm;
2123             s/\xe2\x6f/ó/gm;
2124             s/\xe2\x75/ú/gm;
2125             s/\xe2\x79/ý/gm;
2126             s/\xe3\x41/Â/gm;
2127             s/\xe3\x45/Ê/gm;
2128             s/\xe3\x49/Î/gm;
2129             s/\xe3\x4f/Ô/gm;
2130             s/\xe3\x55/Û/gm;
2131             s/\xe3\x61/â/gm;
2132             s/\xe3\x65/ê/gm;
2133             s/\xe3\x69/î/gm;
2134             s/\xe3\x6f/ô/gm;
2135             s/\xe3\x75/û/gm;
2136             s/\xe4\x41/Ã/gm;
2137             s/\xe4\x4e/Ñ/gm;
2138             s/\xe4\x4f/Õ/gm;
2139             s/\xe4\x61/ã/gm;
2140             s/\xe4\x6e/ñ/gm;
2141             s/\xe4\x6f/õ/gm;
2142             s/\xe8\x45/Ë/gm;
2143             s/\xe8\x49/Ï/gm;
2144             s/\xe8\x65/ë/gm;
2145             s/\xe8\x69/ï/gm;
2146             s/\xe8\x76/ÿ/gm;
2147             s/\xe9\x41/Ä/gm;
2148             s/\xe9\x4f/Ö/gm;
2149             s/\xe9\x55/Ü/gm;
2150             s/\xe9\x61/ä/gm;
2151             s/\xe9\x6f/ö/gm;
2152             s/\xe9\x75/ü/gm;
2153             s/\xea\x41/Å/gm;
2154             s/\xea\x61/å/gm;
2155
2156             # this handles non-sorting blocks (if implementation requires this)
2157             $string = nsb_clean($_);
2158         }
2159     }
2160     return ($string);
2161 }
2162
2163 sub nsb_clean {
2164     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2165     my $NSE = '\x89';    # NSE : Non Sorting Block end
2166                          # handles non sorting blocks
2167     my ($string) = @_;
2168     $_ = $string;
2169     s/$NSB/(/gm;
2170     s/[ ]{0,1}$NSE/) /gm;
2171     $string = $_;
2172     return ($string);
2173 }
2174
2175 sub FindDuplicate {
2176         my ($record)=@_;
2177         my $dbh = C4::Context->dbh;
2178         my $result = MARCmarc2koha($dbh,$record,'');
2179         my $sth;
2180         my ($biblionumber,$bibid,$title);
2181         # search duplicate on ISBN, easy and fast...
2182         if ($result->{isbn}) {
2183                 $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=?");
2184                 $sth->execute($result->{'isbn'});
2185                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2186                 return $biblionumber,$bibid,$title if ($biblionumber);
2187         }
2188         # a more complex search : build a request for SearchMarc::catalogsearch()
2189         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2190         # search on biblio.title
2191         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2192         if ($record->field($tag)) {
2193                 if ($record->field($tag)->subfields($subfield)) {
2194                         push @tags, "'".$tag.$subfield."'";
2195                         push @and_or, "and";
2196                         push @excluding, "";
2197                         push @operator, "contains";
2198                         push @value, $record->field($tag)->subfield($subfield);
2199 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2200                 }
2201         }
2202         # ... and on biblio.author
2203         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2204         if ($record->field($tag)) {
2205                 if ($record->field($tag)->subfields($subfield)) {
2206                         push @tags, "'".$tag.$subfield."'";
2207                         push @and_or, "and";
2208                         push @excluding, "";
2209                         push @operator, "contains";
2210                         push @value, $record->field($tag)->subfield($subfield);
2211 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2212                 }
2213         }
2214         # ... and on publicationyear.
2215         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2216         if ($record->field($tag)) {
2217                 if ($record->field($tag)->subfields($subfield)) {
2218                         push @tags, "'".$tag.$subfield."'";
2219                         push @and_or, "and";
2220                         push @excluding, "";
2221                         push @operator, "=";
2222                         push @value, $record->field($tag)->subfield($subfield);
2223 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2224                 }
2225         }
2226         # ... and on size.
2227         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2228         if ($record->field($tag)) {
2229                 if ($record->field($tag)->subfields($subfield)) {
2230                         push @tags, "'".$tag.$subfield."'";
2231                         push @and_or, "and";
2232                         push @excluding, "";
2233                         push @operator, "=";
2234                         push @value, $record->field($tag)->subfield($subfield);
2235 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2236                 }
2237         }
2238         # ... and on publisher.
2239         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2240         if ($record->field($tag)) {
2241                 if ($record->field($tag)->subfields($subfield)) {
2242                         push @tags, "'".$tag.$subfield."'";
2243                         push @and_or, "and";
2244                         push @excluding, "";
2245                         push @operator, "=";
2246                         push @value, $record->field($tag)->subfield($subfield);
2247 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2248                 }
2249         }
2250         # ... and on volume.
2251         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2252         if ($record->field($tag)) {
2253                 if ($record->field($tag)->subfields($subfield)) {
2254                         push @tags, "'".$tag.$subfield."'";
2255                         push @and_or, "and";
2256                         push @excluding, "";
2257                         push @operator, "=";
2258                         push @value, $record->field($tag)->subfield($subfield);
2259 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2260                 }
2261         }
2262
2263         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2264         # there is at least 1 result => return the 1st one
2265         if ($nbresult) {
2266 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2267                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2268         }
2269         # no result, returns nothing
2270         return;
2271 }
2272
2273 sub DisplayISBN {
2274         my ($isbn)=@_;
2275         my $seg1;
2276         if(substr($isbn, 0, 1) <=7) {
2277                 $seg1 = substr($isbn, 0, 1);
2278         } elsif(substr($isbn, 0, 2) <= 94) {
2279                 $seg1 = substr($isbn, 0, 2);
2280         } elsif(substr($isbn, 0, 3) <= 995) {
2281                 $seg1 = substr($isbn, 0, 3);
2282         } elsif(substr($isbn, 0, 4) <= 9989) {
2283                 $seg1 = substr($isbn, 0, 4);
2284         } else {
2285                 $seg1 = substr($isbn, 0, 5);
2286         }
2287         my $x = substr($isbn, length($seg1));
2288         my $seg2;
2289         if(substr($x, 0, 2) <= 19) {
2290 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2291                 $seg2 = substr($x, 0, 2);
2292         } elsif(substr($x, 0, 3) <= 699) {
2293                 $seg2 = substr($x, 0, 3);
2294         } elsif(substr($x, 0, 4) <= 8399) {
2295                 $seg2 = substr($x, 0, 4);
2296         } elsif(substr($x, 0, 5) <= 89999) {
2297                 $seg2 = substr($x, 0, 5);
2298         } elsif(substr($x, 0, 6) <= 9499999) {
2299                 $seg2 = substr($x, 0, 6);
2300         } else {
2301                 $seg2 = substr($x, 0, 7);
2302         }
2303         my $seg3=substr($x,length($seg2));
2304         $seg3=substr($seg3,0,length($seg3)-1) ;
2305         my $seg4 = substr($x, -1, 1);
2306         return "$seg1-$seg2-$seg3-$seg4";
2307 }
2308
2309
2310 END { }    # module clean-up code here (global destructor)
2311
2312 =back
2313
2314 =head1 AUTHOR
2315
2316 Koha Developement team <info@koha.org>
2317
2318 Paul POULAIN paul.poulain@free.fr
2319
2320 =cut
2321
2322 # $Id$
2323 # $Log$
2324 # Revision 1.127  2005/08/11 14:37:32  tipaul
2325 # * POD documenting
2326 # * removing useless subs
2327 # * removing some subs that are also elsewhere
2328 # * 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)
2329 #
2330 # Revision 1.126  2005/08/11 09:13:28  tipaul
2331 # just removing useless subs (a lot !!!) for code cleaning
2332 #
2333 # Revision 1.125  2005/08/11 09:00:07  tipaul
2334 # Ok guys, this time, it seems that item add and modif begin working as expected...
2335 # Still a lot of bugs to fix, of course
2336 #
2337 # Revision 1.124  2005/08/10 10:21:15  tipaul
2338 # continuing the road to zebra :
2339 # - the biblio add begins to work.
2340 # - the biblio modif begins to work.
2341 #
2342 # (still without doing anything on zebra)
2343 # (no new change in updatedatabase)
2344 #
2345 # Revision 1.123  2005/08/09 14:10:28  tipaul
2346 # 1st commit to go to zebra.
2347 # don't update your cvs if you want to have a working head...
2348 #
2349 # this commit contains :
2350 # * 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...
2351 # * 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.
2352 # * other files : get rid of bibid and use biblionumber instead.
2353 #
2354 # What is broken :
2355 # * does not do anything on zebra yet.
2356 # * if you rename marc_subfield_table, you can't search anymore.
2357 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
2358 # * 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 ;-) )
2359 #
2360 # 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
2361 # 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.
2362
2363 # tipaul cutted previous commit notes