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