koha-dev.rot13.org Git - koha_gimpoz/blob - C4/Biblio.pm

   1 package C4::Biblio;
   2 # $Id$
   3 # $Log$
   4 # Revision 1.23  2002/10/16 12:43:08  arensb
   5 # Added some FIXME comments.
   6 #
   7 # Revision 1.22  2002/10/15 13:39:17  tipaul
   8 # removing Acquisition.pm
   9 # deleting unused code in biblio.pm, rewriting POD and answering most FIXME comments
  10 #
  11 # Revision 1.21  2002/10/13 11:34:14  arensb
  12 # Replaced expressions of the form "$x = $x <op> $y" with "$x <op>= $y".
  13 # Thus, $x = $x+2 becomes $x += 2, and so forth.
  14 #
  15 # Revision 1.20  2002/10/13 08:28:32  arensb
  16 # Deleted unused variables.
  17 # Removed trailing whitespace.
  18 #
  19 # Revision 1.19  2002/10/13 05:56:10  arensb
  20 # Added some FIXME comments.
  21 #
  22 # Revision 1.18  2002/10/11 12:34:53  arensb
  23 # Replaced &requireDBI with C4::Context->dbh
  24 #
  25 # Revision 1.17  2002/10/10 14:48:25  tipaul
  26 # bugfixes
  27 #
  28 # Revision 1.16  2002/10/07 14:04:26  tipaul
  29 # road to 1.3.1 : viewing MARC biblio
  30 #
  31 # Revision 1.15  2002/10/05 09:49:25  arensb
  32 # Merged with arensb-context branch: use C4::Context->dbh instead of
  33 # &C4Connect, and generally prefer C4::Context over C4::Database.
  34 #
  35 # Revision 1.14  2002/10/03 11:28:18  tipaul
  36 # Extending Context.pm to add stopword management and using it in MARC-API.
  37 # First benchmarks show a medium speed improvement, which  is nice as this part is heavily called.
  38 #
  39 # Revision 1.13  2002/10/02 16:26:44  tipaul
  40 # road to 1.3.1
  41 #
  42 # Revision 1.12.2.4  2002/10/05 07:09:31  arensb
  43 # Merged in changes from main branch.
  44 #
  45 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
  46 # Added a whole mess of FIXME comments.
  47 #
  48 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
  49 # Added some missing semicolons.
  50 #
  51 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
  52 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
  53 # C4Connect.
  54 #
  55 # Revision 1.12.2.3  2002/10/05 06:12:10  arensb
  56 # Added a whole mess of FIXME comments.
  57 #
  58 # Revision 1.12.2.2  2002/10/05 04:03:14  arensb
  59 # Added some missing semicolons.
  60 #
  61 # Revision 1.12.2.1  2002/10/04 02:24:01  arensb
  62 # Use C4::Connect instead of C4::Database, C4::Connect->dbh instead
  63 # C4Connect.
  64 #
  65 # Revision 1.12  2002/10/01 11:48:51  arensb
  66 # Added some FIXME comments, mostly marking duplicate functions.
  67 #
  68 # Revision 1.11  2002/09/24 13:49:26  tipaul
  69 # long WAS the road to 1.3.0...
  70 # coming VERY SOON NOW...
  71 # modifying installer and buildrelease to update the DB
  72 #
  73 # Revision 1.10  2002/09/22 16:50:08  arensb
  74 # Added some FIXME comments.
  75 #
  76 # Revision 1.9  2002/09/20 12:57:46  tipaul
  77 # long is the road to 1.4.0
  78 # * MARCadditem and MARCmoditem now wroks
  79 # * various bugfixes in MARC management
  80 # !!! 1.3.0 should be released very soon now. Be careful !!!
  81 #
  82 # Revision 1.8  2002/09/10 13:53:52  tipaul
  83 # MARC API continued...
  84 # * some bugfixes
  85 # * multiple item management : MARCadditem and MARCmoditem have been added. They suppose that ALL the MARC field linked to koha-item are in the same MARC tag (on the same line of MARC file)
  86 #
  87 # Note : it should not be hard for marcimport and marcexport to re-link fields from internal tag/subfield to "legal" tag/subfield.
  88 #
  89 # Revision 1.7  2002/08/14 18:12:51  tonnesen
  90 # Added copyright statement to all .pl and .pm files
  91 #
  92 # Revision 1.6  2002/07/25 13:40:31  tipaul
  93 # pod documenting the API.
  94 #
  95 # Revision 1.5  2002/07/24 16:11:37  tipaul
  96 # Now, the API...
  97 # Database.pm and Output.pm are almost not modified (var test...)
  98 #
  99 # Biblio.pm is almost completly rewritten.
 100 #
 101 # WHAT DOES IT ??? ==> END of Hitchcock suspens
 102 #
 103 # 1st, it does... nothing...
 104 # Every old API should be there. So if MARC-stuff is not done, the behaviour is EXACTLY the same (if there is no added bug, of course). So, if you use normal acquisition, you won't find anything new neither on screen or old-DB tables ...
 105 #
 106 # All old-API functions have been cloned. for example, the "newbiblio" sub, now has become :
 107 # * a "newbiblio" sub, with the same parameters. It just call a sub named OLDnewbiblio
 108 # * a "OLDnewbiblio" sub, which is a copy/paste of the previous newbiblio sub. Then, when you want to add the MARC-DB stuff, you can modify the newbiblio sub without modifying the OLDnewbiblio one. If we correct a bug in 1.2 in newbiblio, we can do the same in main branch by correcting OLDnewbiblio.
 109 # * The MARC stuff is usually done through a sub named MARCxxx where xxx is the same as OLDxxx. For example, newbiblio calls MARCnewbiblio. the MARCxxx subs use a MARC::Record as parameter.
 110 # The last thing to solve was to manage biblios through real MARC import : they must populate the old-db, but must populate the MARC-DB too, without loosing information (if we go from MARC::Record to old-data then back to MARC::Record, we loose A LOT OF ROWS). To do this, there are subs beginning by "ALLxxx" : they manage datas with MARC::Record datas. they call OLDxxx sub too (to populate old-DB), but MARCxxx subs too, with a complete MARC::Record ;-)
 111 #
 112 # In Biblio.pm, there are some subs that permits to build a old-style record from a MARC::Record, and the opposite. There is also a sub finding a MARC-bibid from a old-biblionumber and the opposite too.
 113 # Note we have decided with steve that a old-biblio <=> a MARC-Biblio.
 114 #
 115
 116
 117 # move from 1.2 to 1.4 version :
 118 # 1.2 and previous version uses a specific API to manage biblios. This API uses old-DB style parameters.
 119 # In the 1.4 version, we want to do 2 differents things :
 120 #  - keep populating the old-DB, that has a LOT less datas than MARC
 121 #  - populate the MARC-DB
 122 # To populate the DBs we have 2 differents sources :
 123 #  - the standard acquisition system (through book sellers), that does'nt use MARC data
 124 #  - the MARC acquisition system, that uses MARC data.
 125 #
 126 # thus, we have 2 differents cases :
 127 #   - 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
 128 #   - 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.
 129 #       we MUST have an API for true MARC data, that populate MARC-DB then old-DB
 130 #
 131 # That's why we need 4 subs :
 132 # all subs beginning by MARC manage only MARC tables. They manage MARC-DB with MARC::Record parameters
 133 # all subs beginning by OLD manage only OLD-DB tables. They manage old-DB with old-DB parameters
 134 # all subs beginning by ALL 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
 135 # all subs beginning by seomething else are the old-style API. They use old-DB as parameter, then call internally the OLD and MARC subs.
 136 #
 137 # only ALL and old-style API should be used in koha. MARC and OLD is used internally only
 138 #
 139 # Thus, we assume a nice translation to future versions : if we want in a 1.6 release completly forget old-DB, we can do it easily.
 140 # in 1.4 version, the translations will be nicer, as we have NOTHING to do in code. Everything has to be done in Biblio.pm ;-)
 141
 142
 143
 144 # Copyright 2000-2002 Katipo Communications
 145 #
 146 # This file is part of Koha.
 147 #
 148 # Koha is free software; you can redistribute it and/or modify it under the
 149 # terms of the GNU General Public License as published by the Free Software
 150 # Foundation; either version 2 of the License, or (at your option) any later
 151 # version.
 152 #
 153 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
 154 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 155 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 156 #
 157 # You should have received a copy of the GNU General Public License along with
 158 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
 159 # Suite 330, Boston, MA  02111-1307 USA
 160
 161 use strict;
 162 require Exporter;
 163 use C4::Context;
 164 use C4::Database;
 165 use MARC::Record;
 166
 167 use vars qw($VERSION @ISA @EXPORT);
 168
 169 # set the version for version checking
 170 $VERSION = 0.01;
 171
 172 @ISA = qw(Exporter);
 173 #
 174 # don't forget MARCxxx subs are here only for testing purposes. Should not be used
 175 # as the old-style API and the ALL one are the only public functions.
 176 #
 177 @EXPORT = qw(
 178              &updateBiblio &updateBiblioItem &updateItem
 179              &itemcount &newbiblio &newbiblioitem
 180              &modnote &newsubject &newsubtitle
 181              &modbiblio &checkitems
 182              &newitems &modbibitem
 183              &modsubtitle &modsubject &modaddauthor &moditem &countitems
 184              &delitem &deletebiblioitem &delbiblio
 185              &getitemtypes &getbiblio
 186              &getbiblioitembybiblionumber
 187              &getbiblioitem &getitemsbybiblioitem &isbnsearch
 188              &skip
 189              &newcompletebiblioitem
 190
 191              &MARCfind_oldbiblionumber_from_MARCbibid
 192              &MARCfind_MARCbibid_from_oldbiblionumber
 193
 194              &ALLnewbiblio &ALLnewitem
 195
 196              &MARCgettagslib
 197              &MARCaddbiblio &MARCadditem
 198              &MARCmodsubfield &MARCaddsubfield
 199              &MARCmodbiblio &MARCmoditem
 200              &MARCfindsubfield
 201              &MARCkoha2marcBiblio &MARCmarc2koha &MARCkoha2marcItem
 202              &MARCgetbiblio &MARCgetitem
 203              &MARCaddword &MARCdelword
 204  );
 205
 206 #
 207 #
 208 # MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC MARC
 209 #
 210 #
 211 # all the following subs takes a MARC::Record as parameter and manage
 212 # the MARC-DB. They are called by the 1.0/1.2 xxx subs, and by the
 213 # ALLxxx subs (xxx deals with old-DB parameters, the ALLxxx deals with MARC-DB parameter)
 214
 215 =head1 NAME
 216
 217 C4::Biblio : acquisition, catalog  management functions
 218
 219 =head1 SYNOPSIS
 220
 221 MARCxxx related subs
 222 all subs requires/use $dbh as 1st parameter.
 223 NOTE : all those subs are private and must be used only inside Biblio.pm (called by a old API sub, or the ALLsub)
 224
 225 =head1 DESCRIPTION
 226
 227 I<@tagslib = &MARCgettagslib($dbh,1|0);>
 228
 229 last param is 1 for liblibrarian and 0 for libopac
 230 returns a hash with tag/subfield meaning
 231
 232 I<($tagfield,$tagsubfield) = &MARCfindmarc_from_kohafield($dbh,$kohafield);>
 233
 234 finds MARC tag and subfield for a given kohafield
 235 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
 236
 237 I<$biblionumber = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$MARCbibi);>
 238
 239 finds a old-db biblio number for a given MARCbibid number
 240
 241 I<$bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$oldbiblionumber);>
 242
 243 finds a MARC bibid from a old-db biblionumber
 244
 245 I<&MARCaddbiblio($dbh,$MARC::Record,$biblionumber);>
 246
 247 creates a biblio (in the MARC tables only). $biblionumber is the old-db biblionumber of the biblio
 248
 249 I<&MARCaddsubfield($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);>
 250
 251 adds a subfield in a biblio (in the MARC tables only).
 252
 253 I<$MARCRecord = &MARCgetbiblio($dbh,$bibid);>
 254
 255 Returns a MARC::Record for the biblio $bibid.
 256
 257 I<&MARCmodbiblio($dbh,$bibid,$delete,$record);>
 258
 259 MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
 260 if $delete == 1, every field/subfield not found is deleted in the biblio
 261 otherwise, only data passed to MARCmodbiblio is managed.
 262 thus, you can change only a small part of a biblio (like an item, or a subtitle, or a additionalauthor...)
 263
 264 I<($subfieldid,$subfieldvalue) = &MARCmodsubfield($dbh,$subfieldid,$subfieldvalue);>
 265
 266 MARCmodsubfield changes the value of a given subfield
 267
 268 I<$subfieldid = &MARCfindsubfield($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue);>
 269
 270 MARCfindsubfield returns a subfield number given a bibid/tag/subfieldvalue values.
 271 Returns -1 if more than 1 answer
 272
 273 I<$subfieldid = &MARCfindsubfieldid($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);>
 274
 275 MARCfindsubfieldid find a subfieldid for a bibid/tag/tagorder/subfield/subfieldorder
 276
 277 I<&MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);>
 278
 279 MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
 280
 281 I<&MARCdelbiblio($dbh,$bibid);>
 282
 283 MARCdelbiblio delete biblio $bibid
 284
 285 I<$MARCRecord = &MARCkoha2marcBiblio($dbh,$biblionumber,biblioitemnumber);>
 286
 287 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem
 288
 289 I<$MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);>
 290
 291 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB item
 292
 293 I<$MARCRecord = &MARCkoha2marcSubtitle($dbh,$biblionumber,$subtitle);>
 294
 295 MARCkoha2marcSubtitle is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB subtitle
 296
 297 I<&MARCkoha2marcOnefield => used by MARCkoha2marc and should not be useful elsewhere>
 298
 299 I<$olddb = &MARCmarc2koha($dbh,$MARCRecord);>
 300
 301 builds a hash with old-db datas from a MARC::Record
 302
 303 I<&MARCmarc2kohaOnefield => used by MARCmarc2koha and should not be useful elsewhere>
 304
 305 I<MARCaddword => used to manage MARC_word table and should not be useful elsewhere>
 306
 307 I<MARCdelword => used to manage MARC_word table and should not be useful elsewhere>
 308
 309 =head1 AUTHOR
 310
 311 Paul POULAIN paul.poulain@free.fr
 312
 313 =cut
 314
 315 sub MARCgettagslib {
 316     my ($dbh,$forlibrarian)= @_;
 317     my $sth;
 318     if ($forlibrarian eq 1) {
 319         $sth=$dbh->prepare("select tagfield,liblibrarian as lib from marc_tag_structure");
 320     } else {
 321         $sth=$dbh->prepare("select tagfield,libopac as lib from marc_tag_structure");
 322     }
 323     $sth->execute;
 324     my ($lib,$tag,$res,$tab);
 325     while ( ($tag,$lib,$tab) = $sth->fetchrow) {
 326         $res->{$tag}->{lib}=$lib;
 327         $res->{$tab}->{tab}="";
 328     }
 329
 330     if ($forlibrarian eq 1) {
 331         $sth=$dbh->prepare("select tagfield,tagsubfield,liblibrarian as lib,tab from marc_subfield_structure");
 332     } else {
 333         $sth=$dbh->prepare("select tagfield,tagsubfield,libopac as lib,tab from marc_subfield_structure");
 334     }
 335     $sth->execute;
 336
 337     my $subfield;
 338     while ( ($tag,$subfield,$lib,$tab) = $sth->fetchrow) {
 339         $res->{$tag}->{$subfield}->{lib}=$lib;
 340         $res->{$tag}->{$subfield}->{tab}=$tab;
 341     }
 342     return $res;
 343 }
 344
 345 sub MARCfind_marc_from_kohafield {
 346     my ($dbh,$kohafield) = @_;
 347     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 348     $sth->execute($kohafield);
 349     my ($tagfield,$tagsubfield) = $sth->fetchrow;
 350     return ($tagfield,$tagsubfield);
 351 }
 352
 353 sub MARCfind_oldbiblionumber_from_MARCbibid {
 354     my ($dbh,$MARCbibid) = @_;
 355     my $sth=$dbh->prepare("select biblionumber from marc_biblio where bibid=?");
 356     $sth->execute($MARCbibid);
 357     my ($biblionumber) = $sth->fetchrow;
 358     return $biblionumber;
 359 }
 360
 361 sub MARCfind_MARCbibid_from_oldbiblionumber {
 362     my ($dbh,$oldbiblionumber) = @_;
 363     my $sth=$dbh->prepare("select bibid from marc_biblio where biblionumber=?");
 364     $sth->execute($oldbiblionumber);
 365     my ($bibid) = $sth->fetchrow;
 366     return $bibid;
 367 }
 368
 369 sub MARCaddbiblio {
 370 # pass the MARC::Record to this function, and it will create the records in the marc tables
 371     my ($dbh,$record,$biblionumber) = @_;
 372     my @fields=$record->fields();
 373     my $bibid;
 374     # adding main table, and retrieving bibid
 375     $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
 376     my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber) values (now(),?)");
 377     $sth->execute($biblionumber);
 378     $sth=$dbh->prepare("select max(bibid) from marc_biblio");
 379     $sth->execute;
 380     ($bibid)=$sth->fetchrow;
 381     $sth->finish;
 382     my $fieldcount=0;
 383     # now, add subfields...
 384     foreach my $field (@fields) {
 385         my @subfields=$field->subfields();
 386         $fieldcount++;
 387         foreach my $subfieldcount (0..$#subfields) {
 388                     &MARCaddsubfield($dbh,$bibid,
 389                                  $field->tag(),
 390                                  $field->indicator(1).$field->indicator(2),
 391                                  $fieldcount,
 392                                  $subfields[$subfieldcount][0],
 393                                  $subfieldcount+1,
 394                                  $subfields[$subfieldcount][1]
 395                                  );
 396         }
 397     }
 398     $dbh->do("unlock tables");
 399     return $bibid;
 400 }
 401
 402 sub MARCadditem {
 403 # pass the MARC::Record to this function, and it will create the records in the marc tables
 404     my ($dbh,$record,$biblionumber) = @_;
 405 # search for MARC biblionumber
 406     $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ");
 407     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
 408     my @fields=$record->fields();
 409     my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
 410     $sth->execute($bibid);
 411     my ($fieldcount) = $sth->fetchrow;
 412     # now, add subfields...
 413     foreach my $field (@fields) {
 414         my @subfields=$field->subfields();
 415         $fieldcount++;
 416         foreach my $subfieldcount (0..$#subfields) {
 417                     &MARCaddsubfield($dbh,$bibid,
 418                                  $field->tag(),
 419                                  $field->indicator(1).$field->indicator(2),
 420                                  $fieldcount,
 421                                  $subfields[$subfieldcount][0],
 422                                  $subfieldcount+1,
 423                                  $subfields[$subfieldcount][1]
 424                                  );
 425         }
 426     }
 427     $dbh->do("unlock tables");
 428     return $bibid;
 429 }
 430
 431 sub MARCaddsubfield {
 432 # Add a new subfield to a tag into the DB.
 433     my ($dbh,$bibid,$tagid,$indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
 434     # if not value, end of job, we do nothing
 435     if (not($subfieldvalue)) {
 436         return;
 437     }
 438     if (not($subfieldcode)) {
 439         $subfieldcode=' ';
 440     }
 441     if (length($subfieldvalue)>255) {
 442 #       $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE");
 443         my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
 444         $sth->execute($subfieldvalue);
 445         $sth=$dbh->prepare("select max(blobidlink)from marc_blob_subfield");
 446         $sth->execute;
 447         my ($res)=$sth->fetchrow;
 448         $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?)");
 449         if ($tagid<100) {
 450             $sth->execute($bibid,'0'.$tagid,$tagorder,$subfieldcode,$subfieldorder,$res);
 451         } else {
 452             $sth->execute($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$res);
 453         }
 454         if ($sth->errstr) {
 455             print STDERR "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 456         }
 457 #       $dbh->do("unlock tables");
 458     } else {
 459         my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?)");
 460         $sth->execute($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 461         if ($sth->errstr) {
 462             print STDERR "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue)\n";
 463         }
 464     }
 465     &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 466 }
 467
 468
 469 sub MARCgetbiblio {
 470 # Returns MARC::Record of the biblio passed in parameter.
 471     my ($dbh,$bibid)=@_;
 472     my $record = MARC::Record->new();
 473 #---- TODO : the leader is missing
 474     my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
 475                                  from marc_subfield_table
 476                                  where bibid=? order by tagorder,subfieldorder
 477                          ");
 478     my $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
 479     $sth->execute($bibid);
 480     my $prevtagorder=1;
 481     my $prevtag;
 482     my %subfieldlist={};
 483     while (my $row=$sth->fetchrow_hashref) {
 484                 if ($row->{'valuebloblink'}) { #---- search blob if there is one
 485                         $sth2->execute($row->{'valuebloblink'});
 486                         my $row2=$sth2->fetchrow_hashref;
 487                         $sth2->finish;
 488                         $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
 489                 }
 490                 if ($row->{tagorder} ne $prevtagorder) {
 491                         my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
 492                         $record->add_fields($field);
 493                         $prevtagorder=$row->{tagorder};
 494                         $prevtag = $row->{tag};
 495                         %subfieldlist={};
 496                         %subfieldlist->{$row->{'subfieldcode'}} = $row->{'subfieldvalue'};
 497                 } else {
 498                         %subfieldlist->{$row->{'subfieldcode'}} = $row->{'subfieldvalue'};
 499                         $prevtag= $row->{tag};
 500                 }
 501         }
 502         # the last has not been included inside the loop... do it now !
 503         my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
 504         $record->add_fields($field);
 505         return $record;
 506 }
 507 sub MARCgetitem {
 508 # Returns MARC::Record of the biblio passed in parameter.
 509     my ($dbh,$bibid,$itemnumber)=@_;
 510     my $record = MARC::Record->new();
 511 # search MARC tagorder
 512     my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
 513     $sth2->execute($bibid,$itemnumber);
 514     my ($tagorder) = $sth2->fetchrow_array();
 515 #---- TODO : the leader is missing
 516     my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
 517                                  from marc_subfield_table
 518                                  where bibid=? and tagorder=? order by subfieldorder
 519                          ");
 520         $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?");
 521         $sth->execute($bibid,$tagorder);
 522         while (my $row=$sth->fetchrow_hashref) {
 523         if ($row->{'valuebloblink'}) { #---- search blob if there is one
 524                 $sth2->execute($row->{'valuebloblink'});
 525                 my $row2=$sth2->fetchrow_hashref;
 526                 $sth2->finish;
 527                 $row->{'subfieldvalue'}=$row2->{'subfieldvalue'};
 528         }
 529         if ($record->field($row->{'tag'})) {
 530             my $field;
 531 #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number...
 532 #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\
 533             if (length($row->{'tag'}) <3) {
 534                 $row->{'tag'} = "0".$row->{'tag'};
 535             }
 536             $field =$record->field($row->{'tag'});
 537             if ($field) {
 538                 my $x = $field->add_subfields($row->{'subfieldcode'},$row->{'subfieldvalue'});
 539                 $record->delete_field($field);
 540                 $record->add_fields($field);
 541             }
 542         } else {
 543             if (length($row->{'tag'}) < 3) {
 544                 $row->{'tag'} = "0".$row->{'tag'};
 545             }
 546             my $temp = MARC::Field->new($row->{'tag'}," "," ", $row->{'subfieldcode'} => $row->{'subfieldvalue'});
 547             $record->add_fields($temp);
 548         }
 549
 550     }
 551     return $record;
 552 }
 553
 554 sub MARCmodbiblio {
 555     my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
 556     my $oldrecord=&MARCgetbiblio($dbh,$bibid);
 557 # if nothing to change, don't waste time...
 558     if ($oldrecord eq $record) {
 559         return;
 560     }
 561 # otherwise, skip through each subfield...
 562     my @fields = $record->fields();
 563     my $tagorder=0;
 564     foreach my $field (@fields) {
 565         my $oldfield = $oldrecord->field($field->tag());
 566         my @subfields=$field->subfields();
 567         my $subfieldorder=0;
 568         $tagorder++;
 569         foreach my $subfield (@subfields) {
 570             $subfieldorder++;
 571             if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
 572 # just adding datas...
 573                 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
 574                                  1,@$subfield[0],$subfieldorder,@$subfield[1]);
 575             } else {
 576 # modify he subfield if it's a different string
 577                 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
 578                     my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
 579                     &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
 580                 } else {
 581                 }
 582             }
 583         }
 584     }
 585 }
 586 sub MARCmoditem {
 587     my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
 588     my $oldrecord=&MARCgetitem($dbh,$bibid,$itemnumber);
 589 # if nothing to change, don't waste time...
 590     if ($oldrecord eq $record) {
 591         return;
 592     }
 593 # otherwise, skip through each subfield...
 594     my @fields = $record->fields();
 595 # search old MARC item
 596     my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?");
 597     $sth2->execute($bibid,$itemnumber);
 598     my ($tagorder) = $sth2->fetchrow_array();
 599     foreach my $field (@fields) {
 600         my $oldfield = $oldrecord->field($field->tag());
 601         my @subfields=$field->subfields();
 602         my $subfieldorder=0;
 603         foreach my $subfield (@subfields) {
 604             $subfieldorder++;
 605             if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
 606 # just adding datas...
 607                 &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
 608                                  $tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
 609             } else {
 610 # modify he subfield if it's a different string
 611                 if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
 612                     my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
 613                     &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
 614                 } else {
 615                 }
 616             }
 617         }
 618     }
 619 }
 620
 621
 622 sub MARCmodsubfield {
 623 # Subroutine changes a subfield value given a subfieldid.
 624     my ($dbh, $subfieldid, $subfieldvalue )=@_;
 625     $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
 626     my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?");
 627     $sth1->execute($subfieldid);
 628     my ($oldvaluebloblink)=$sth1->fetchrow;
 629     $sth1->finish;
 630     my $sth;
 631     # if too long, use a bloblink
 632     if (length($subfieldvalue)>255 ) {
 633         # if already a bloblink, update it, otherwise, insert a new one.
 634         if ($oldvaluebloblink) {
 635             $sth=$dbh->prepare("update marc_blob_subfield set subfieldvalue=? where blobidlink=?");
 636             $sth->execute($subfieldvalue,$oldvaluebloblink);
 637         } else {
 638             $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)");
 639             $sth->execute($subfieldvalue);
 640             $sth=$dbh->prepare("select max(blobidlink) from marc_blob_subfield");
 641             $sth->execute;
 642             my ($res)=$sth->fetchrow;
 643             $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=null, valuebloblink=$res where subfieldid=?");
 644             $sth->execute($subfieldid);
 645         }
 646     } else {
 647         # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
 648         $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?");
 649         $sth->execute($subfieldvalue, $subfieldid);
 650     }
 651     $dbh->do("unlock tables");
 652     $sth->finish;
 653     $sth=$dbh->prepare("select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?");
 654     $sth->execute($subfieldid);
 655     my ($bibid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow;
 656     $subfieldid=$x;
 657     &MARCdelword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder);
 658     &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue);
 659     return($subfieldid, $subfieldvalue);
 660 }
 661
 662 sub MARCfindsubfield {
 663     my ($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_;
 664     my $resultcounter=0;
 665     my $subfieldid;
 666     my $lastsubfieldid;
 667     my $query="select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
 668     if ($subfieldvalue) {
 669         $query .= " and subfieldvalue=".$dbh->quote($subfieldvalue);
 670     } else {
 671         if ($subfieldorder<1) {
 672             $subfieldorder=1;
 673         }
 674         $query .= " and subfieldorder=$subfieldorder";
 675     }
 676     my $sti=$dbh->prepare($query);
 677     $sti->execute($bibid,$tag, $subfieldcode);
 678     while (($subfieldid) = $sti->fetchrow) {
 679         $resultcounter++;
 680         $lastsubfieldid=$subfieldid;
 681     }
 682     if ($resultcounter>1) {
 683         # Error condition.  Values given did not resolve into a unique record.  Don't know what to edit
 684         # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange)
 685         return -1;
 686     } else {
 687         return $lastsubfieldid;
 688     }
 689 }
 690
 691 sub MARCfindsubfieldid {
 692     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
 693     my $sth=$dbh->prepare("select subfieldid from marc_subfield_table
 694                         where bibid=? and tag=? and tagorder=?
 695                                 and subfieldcode=? and subfieldorder=?");
 696     $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
 697     my ($res) = $sth->fetchrow;
 698     return $res;
 699 }
 700
 701 sub MARCdelsubfield {
 702 # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
 703     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
 704     $dbh->do("delete from marc_subfield_table where bibid='$bibid' and
 705                         tag='$tag' and tagorder='$tagorder'
 706                         and subfieldcode='$subfield' and subfieldorder='$subfieldorder
 707                         ");
 708 }
 709
 710 sub MARCdelbiblio {
 711 # delete a biblio for a $bibid
 712     my ($dbh,$bibid) = @_;
 713     $dbh->do("delete from marc_subfield_table where bibid='$bibid'");
 714     $dbh->do("delete from marc_biblio where bibid='$bibid'");
 715 }
 716
 717 sub MARCkoha2marcBiblio {
 718 # this function builds partial MARC::Record from the old koha-DB fields
 719     my ($dbh,$biblionumber,$biblioitemnumber) = @_;
 720     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 721     my $record = MARC::Record->new();
 722 #--- if bibid, then retrieve old-style koha data
 723     if ($biblionumber>0) {
 724         my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
 725                 from biblio where biblionumber=?");
 726         $sth2->execute($biblionumber);
 727         my $row=$sth2->fetchrow_hashref;
 728         my $code;
 729         foreach $code (keys %$row) {
 730             if ($row->{$code}) {
 731                 &MARCkoha2marcOnefield($sth,$record,"biblio.".$code,$row->{$code});
 732             }
 733         }
 734     }
 735 #--- if biblioitem, then retrieve old-style koha data
 736     if ($biblioitemnumber>0) {
 737         my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification,
 738                                                 itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
 739                                                 volumedate,volumeddesc,timestamp,illus,pages,notes,size,place
 740                                         FROM biblioitems
 741                                         WHERE biblionumber=? and biblioitemnumber=?
 742                                         ");
 743         $sth2->execute($biblionumber,$biblioitemnumber);
 744         my $row=$sth2->fetchrow_hashref;
 745         my $code;
 746         foreach $code (keys %$row) {
 747             if ($row->{$code}) {
 748                 &MARCkoha2marcOnefield($sth,$record,"biblioitems.".$code,$row->{$code});
 749             }
 750         }
 751     }
 752     return $record;
 753 # TODO : retrieve notes, additionalauthors
 754 }
 755
 756 sub MARCkoha2marcItem {
 757 # this function builds partial MARC::Record from the old koha-DB fields
 758     my ($dbh,$biblionumber,$itemnumber) = @_;
 759 #    my $dbh=&C4Connect;
 760     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 761     my $record = MARC::Record->new();
 762 #--- if item, then retrieve old-style koha data
 763     if ($itemnumber>0) {
 764 #       print STDERR "prepare $biblionumber,$itemnumber\n";
 765         my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
 766                                                 booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
 767                                                 datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,bulk,issues,renewals,
 768                                         reserves,restricted,binding,itemnotes,holdingbranch,timestamp
 769                                         FROM items
 770                                         WHERE itemnumber=?");
 771         $sth2->execute($itemnumber);
 772         my $row=$sth2->fetchrow_hashref;
 773         my $code;
 774         foreach $code (keys %$row) {
 775             if ($row->{$code}) {
 776                 &MARCkoha2marcOnefield($sth,$record,"items.".$code,$row->{$code});
 777             }
 778         }
 779     }
 780     return $record;
 781 # TODO : retrieve notes, additionalauthors
 782 }
 783
 784 sub MARCkoha2marcSubtitle {
 785 # this function builds partial MARC::Record from the old koha-DB fields
 786     my ($dbh,$bibnum,$subtitle) = @_;
 787     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 788     my $record = MARC::Record->new();
 789     &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle);
 790     return $record;
 791 }
 792
 793 sub MARCkoha2marcOnefield {
 794     my ($sth,$record,$kohafieldname,$value)=@_;
 795     my $tagfield;
 796     my $tagsubfield;
 797     $sth->execute($kohafieldname);
 798     if (($tagfield,$tagsubfield)=$sth->fetchrow) {
 799         if ($record->field($tagfield)) {
 800             my $tag =$record->field($tagfield);
 801             if ($tag) {
 802                 $tag->add_subfields($tagsubfield,$value);
 803                 $record->delete_field($tag);
 804                 $record->add_fields($tag);
 805             }
 806         } else {
 807             $record->add_fields($tagfield," "," ",$tagsubfield => $value);
 808         }
 809     }
 810     return $record;
 811 }
 812
 813 sub MARCmarc2koha {
 814         my ($dbh,$record) = @_;
 815         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 816         my $result;
 817         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
 818         $sth2->execute;
 819         my $field;
 820         #    print STDERR $record->as_formatted;
 821         while (($field)=$sth2->fetchrow) {
 822                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result);
 823         }
 824         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
 825         $sth2->execute;
 826         while (($field)=$sth2->fetchrow) {
 827                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result);
 828         }
 829         $sth2=$dbh->prepare("SHOW COLUMNS from items");
 830         $sth2->execute;
 831         while (($field)=$sth2->fetchrow) {
 832                 $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
 833         }
 834         # additional authors : specific
 835         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
 836         return $result;
 837 }
 838
 839 sub MARCmarc2kohaOneField {
 840 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
 841     my ($sth,$kohatable,$kohafield,$record,$result)= @_;
 842     my $res="";
 843     my $tagfield;
 844     my $subfield;
 845     $sth->execute($kohatable.".".$kohafield);
 846     ($tagfield,$subfield) = $sth->fetchrow;
 847     foreach my $field ($record->field($tagfield)) {
 848         if ($field->subfield($subfield)) {
 849             if ($result->{$kohafield}) {
 850                 $result->{$kohafield} .= " | ".$field->subfield($subfield);
 851             } else {
 852                 $result->{$kohafield}=$field->subfield($subfield);
 853             }
 854         }
 855     }
 856     return $result;
 857 }
 858
 859 sub MARCaddword {
 860 # split a subfield string and adds it into the word table.
 861 # removes stopwords
 862     my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_;
 863     $sentence =~ s/(\.|\?|\:|\!|\'|,|\-)/ /g;
 864     my @words = split / /,$sentence;
 865     my $stopwords= C4::Context->stopwords;
 866     my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
 867                         values (?,?,?,?,?,?,soundex(?))");
 868     foreach my $word (@words) {
 869 # we record only words longer than 2 car and not in stopwords hash
 870         if (length($word)>1 and !($stopwords->{uc($word)})) {
 871             $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
 872             if ($sth->err()) {
 873                 print STDERR "ERROR ==> insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
 874             }
 875         }
 876     }
 877 }
 878
 879 sub MARCdelword {
 880 # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add
 881     my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_;
 882     my $sth=$dbh->prepare("delete from marc_word where bibid=? and tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
 883     $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder);
 884 }
 885
 886 #
 887 #
 888 # ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL ALL
 889 #
 890 #
 891 # all the following subs are useful to manage MARC-DB with complete MARC records.
 892 # it's used with marcimport, and marc management tools
 893 #
 894
 895 =head1 SYNOPSIS
 896   ALLxxx related subs
 897   all subs requires/use $dbh as 1st parameter.
 898   those subs are used by the MARC-compliant version of koha : marc import, or marc management.
 899
 900 =head1 DESCRIPTION
 901
 902 I<(oldbibnum,$oldbibitemnum) = ALLnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem);>
 903
 904 creates a new biblio from a MARC::Record. The 3rd and 4th parameter are hashes and may be ignored. If only 2 params are passed to the sub, the old-db hashes
 905 are builded from the MARC::Record. If they are passed, they are used.
 906
 907 I<ALLnewitem($dbh,$olditem);>
 908
 909 adds an item in the db. $olditem is a old-db hash.
 910
 911 =head1 AUTHOR
 912
 913 Paul POULAIN paul.poulain@free.fr
 914
 915 =cut
 916
 917 sub ALLnewbiblio {
 918     my ($dbh, $record, $oldbiblio, $oldbiblioitem) = @_;
 919 # note $oldbiblio and $oldbiblioitem are not mandatory.
 920 # if not present, they will be builded from $record with MARCmarc2koha function
 921     if (($oldbiblio) and not($oldbiblioitem)) {
 922         print STDERR "ALLnewbiblio : missing parameter\n";
 923         print "ALLnewbiblio : missing parameter : contact koha development  team\n";
 924         die;
 925     }
 926     my $oldbibnum;
 927     my $oldbibitemnum;
 928     if ($oldbiblio) {
 929         $oldbibnum = OLDnewbiblio($dbh,$oldbiblio);
 930         $oldbiblioitem->{'biblionumber'} = $oldbibnum;
 931         $oldbibitemnum = OLDnewbiblioitem($dbh,$oldbiblioitem);
 932     } else {
 933         my $olddata = MARCmarc2koha($dbh,$record);
 934         $oldbibnum = OLDnewbiblio($dbh,$olddata);
 935         $oldbibitemnum = OLDnewbiblioitem($dbh,$olddata);
 936     }
 937 # we must add bibnum and bibitemnum in MARC::Record...
 938 # we build the new field with biblionumber and biblioitemnumber
 939 # we drop the original field
 940 # we add the new builded field.
 941 # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber
 942 # (steve and paul : thinks 090 is a good choice)
 943     my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
 944     $sth->execute("biblio.biblionumber");
 945     (my $tagfield1, my $tagsubfield1) = $sth->fetchrow;
 946     $sth->execute("biblioitems.biblioitemnumber");
 947     (my $tagfield2, my $tagsubfield2) = $sth->fetchrow;
 948     if ($tagsubfield1 != $tagsubfield2) {
 949         print STDERR "Error in ALLnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
 950         print "Error in ALLnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
 951         die;
 952     }
 953     my $newfield = MARC::Field->new( $tagfield1,'','',
 954                                      "$tagsubfield1" => $oldbibnum,
 955                                      "$tagsubfield2" => $oldbibitemnum);
 956 # drop old field and create new one...
 957     my $old_field = $record->field($tagfield1);
 958     $record->delete_field($old_field);
 959     $record->add_fields($newfield);
 960     my $bibid = MARCaddbiblio($dbh,$record,$oldbibnum);
 961     return ( $oldbibnum,$oldbibitemnum );
 962 }
 963
 964 sub ALLnewitem {
 965     my ($dbh, $item) = @_;
 966     my $itemnumber;
 967     my $error;
 968     ($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{'barcode'});
 969 # search MARC biblionumber
 970     my $bibid=&MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{'biblionumber'});
 971 # calculate tagorder
 972     my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?");
 973     $sth->execute($bibid);
 974     my ($tagorder) = $sth->fetchrow;
 975     $tagorder++;
 976     my $subfieldorder=0;
 977 # for each field, find MARC tag and subfield, and call the proper MARC sub
 978     foreach my $itemkey (keys %$item) {
 979         my $tagfield;
 980         my $tagsubfield;
 981         if ($itemkey eq "biblionumber" || $itemkey eq "biblioitemnumber") {
 982             ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"biblio.".$itemkey);
 983         } else {
 984             ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"items.".$itemkey);
 985         }
 986         if ($tagfield && $item->{$itemkey} ne 'NULL') {
 987             $subfieldorder++;
 988             &MARCaddsubfield($dbh,
 989                              $bibid,
 990                              $tagfield,
 991                              "  ",
 992                              $tagorder,
 993                              $tagsubfield,
 994                              $subfieldorder,
 995                              $item->{$itemkey}
 996                              );
 997         }
 998     }
 999 } # ALLnewitems
1000
1001
1002 #
1003 #
1004 # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
1005 #
1006 #
1007
1008 =head1 SYNOPSIS
1009
1010   OLDxxx related subs
1011   all subs requires/use $dbh as 1st parameter.
1012   those subs are used by the MARC-compliant version of koha : marc import, or marc management.
1013
1014   They all are the exact copy of 1.0/1.2 version of the sub
1015   without the OLD. The OLDxxx is called by the original xxx sub.
1016   the 1.4 xxx sub also builds MARC::Record an calls the MARCxxx
1017
1018   WARNING : there is 1 difference between initialxxx and OLDxxx :
1019   the db header $dbh is always passed as parameter
1020   to avoid over-DB connexion
1021
1022 =head1 DESCRIPTION
1023
1024 I<$biblionumber = OLDnewbiblio($dbh,$biblio);>
1025
1026 adds a record in biblio table. Datas are in the hash $biblio.
1027
1028 I<$biblionumber = OLDmodbiblio($dbh,$biblio);>
1029
1030 modify a record in biblio table. Datas are in the hash $biblio.
1031
1032 I<OLDmodsubtitle($dbh,$bibnum,$subtitle);>
1033
1034 modify subtitles in bibliosubtitle table.
1035
1036 I<OLDmodaddauthor($dbh,$bibnum,$author);>
1037
1038 adds or modify additional authors
1039 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1040
1041 I<$errors = OLDmodsubject($dbh,$bibnum, $force, @subject);>
1042
1043 modify/adds subjects
1044
1045 I<OLDmodbibitem($dbh, $biblioitem);>
1046
1047 modify a biblioitem
1048
1049 I<OLDmodnote($dbh,$bibitemnum,$note>
1050
1051 modify a note for a biblioitem
1052
1053 I<OLDnewbiblioitem($dbh,$biblioitem);>
1054
1055 adds a biblioitem ($biblioitem is a hash with the values)
1056
1057 I<OLDnewsubject($dbh,$bibnum);>
1058
1059 adds a subject
1060
1061 I<OLDnewsubtitle($dbh,$bibnum,$subtitle);>
1062
1063 create a new subtitle
1064
1065 I<($itemnumber,$errors)= OLDnewitems($dbh,$item,$barcode);>
1066
1067 create a item. $item is a hash and $barcode the barcode.
1068
1069 I<OLDmoditem($dbh,$item);>
1070
1071 modify item
1072
1073 I<OLDdelitem($dbh,$itemnum);>
1074
1075 delete item
1076
1077 I<OLDdeletebiblioitem($dbh,$biblioitemnumber);>
1078
1079 deletes a biblioitem
1080 NOTE : not standard sub name. Should be OLDdelbiblioitem()
1081
1082 I<OLDdelbiblio($dbh,$biblio);>
1083
1084 delete a biblio
1085
1086 =head1 AUTHOR
1087
1088 Paul POULAIN paul.poulain@free.fr
1089
1090 =cut
1091
1092 sub OLDnewbiblio {
1093   my ($dbh,$biblio) = @_;
1094 #  my $dbh    = &C4Connect;
1095   my $query  = "Select max(biblionumber) from biblio";
1096   my $sth    = $dbh->prepare($query);
1097   $sth->execute;
1098   my $data   = $sth->fetchrow_arrayref;
1099   my $bibnum = $$data[0] + 1;
1100   my $series = 0;
1101
1102   $biblio->{'title'}       = $dbh->quote($biblio->{'title'});
1103   $biblio->{'author'}      = $dbh->quote($biblio->{'author'});
1104   $biblio->{'copyright'}   = $dbh->quote($biblio->{'copyright'});
1105   $biblio->{'seriestitle'} = $dbh->quote($biblio->{'seriestitle'});
1106   $biblio->{'notes'}       = $dbh->quote($biblio->{'notes'});
1107   $biblio->{'abstract'}    = $dbh->quote($biblio->{'abstract'});
1108   if ($biblio->{'seriestitle'}) { $series = 1 };
1109
1110   $sth->finish;
1111   $query = "insert into biblio set
1112 biblionumber  = $bibnum,
1113 title         = $biblio->{'title'},
1114 author        = $biblio->{'author'},
1115 copyrightdate = $biblio->{'copyright'},
1116 serial        = $series,
1117 seriestitle   = $biblio->{'seriestitle'},
1118 notes         = $biblio->{'notes'},
1119 abstract      = $biblio->{'abstract'}";
1120
1121   $sth = $dbh->prepare($query);
1122   $sth->execute;
1123
1124   $sth->finish;
1125 #  $dbh->disconnect;
1126   return($bibnum);
1127 }
1128
1129 sub OLDmodbiblio {
1130     my ($dbh,$biblio) = @_;
1131 #  my $dbh   = C4Connect;
1132     my $query;
1133     my $sth;
1134
1135     $biblio->{'title'}         = $dbh->quote($biblio->{'title'});
1136     $biblio->{'author'}        = $dbh->quote($biblio->{'author'});
1137     $biblio->{'abstract'}      = $dbh->quote($biblio->{'abstract'});
1138     $biblio->{'copyrightdate'} = $dbh->quote($biblio->{'copyrightdate'});
1139     $biblio->{'seriestitle'}   = $dbh->quote($biblio->{'serirestitle'});
1140     $biblio->{'serial'}        = $dbh->quote($biblio->{'serial'});
1141     $biblio->{'unititle'}      = $dbh->quote($biblio->{'unititle'});
1142     $biblio->{'notes'}         = $dbh->quote($biblio->{'notes'});
1143
1144     $query = "Update biblio set
1145 title         = $biblio->{'title'},
1146 author        = $biblio->{'author'},
1147 abstract      = $biblio->{'abstract'},
1148 copyrightdate = $biblio->{'copyrightdate'},
1149 seriestitle   = $biblio->{'seriestitle'},
1150 serial        = $biblio->{'serial'},
1151 unititle      = $biblio->{'unititle'},
1152 notes         = $biblio->{'notes'}
1153 where biblionumber = $biblio->{'biblionumber'}";
1154     $sth   = $dbh->prepare($query);
1155
1156     $sth->execute;
1157
1158     $sth->finish;
1159     return($biblio->{'biblionumber'});
1160 } # sub modbiblio
1161
1162 sub OLDmodsubtitle {
1163   my ($dbh,$bibnum, $subtitle) = @_;
1164 #  my $dbh   = C4Connect;
1165   my $query = "update bibliosubtitle set
1166 subtitle = '$subtitle'
1167 where biblionumber = $bibnum";
1168   my $sth   = $dbh->prepare($query);
1169
1170   $sth->execute;
1171   $sth->finish;
1172 #  $dbh->disconnect;
1173 } # sub modsubtitle
1174
1175
1176 sub OLDmodaddauthor {
1177     my ($dbh,$bibnum, $author) = @_;
1178 #    my $dbh   = C4Connect;
1179     my $query = "Delete from additionalauthors where biblionumber = $bibnum";
1180     my $sth = $dbh->prepare($query);
1181
1182     $sth->execute;
1183     $sth->finish;
1184
1185     if ($author ne '') {
1186         $query = "Insert into additionalauthors set
1187                         author       = '$author',
1188                         biblionumber = '$bibnum'";
1189         $sth   = $dbh->prepare($query);
1190
1191         $sth->execute;
1192
1193         $sth->finish;
1194     } # if
1195 } # sub modaddauthor
1196
1197
1198 sub OLDmodsubject {
1199     my ($dbh,$bibnum, $force, @subject) = @_;
1200 #  my $dbh   = C4Connect;
1201     my $count = @subject;
1202     my $error;
1203     for (my $i = 0; $i < $count; $i++) {
1204         $subject[$i] =~ s/^ //g;
1205         $subject[$i] =~ s/ $//g;
1206         my $query = "select * from catalogueentry
1207                         where entrytype = 's'
1208                                 and catalogueentry = '$subject[$i]'";
1209         my $sth   = $dbh->prepare($query);
1210         $sth->execute;
1211
1212         if (my $data = $sth->fetchrow_hashref) {
1213         } else {
1214             if ($force eq $subject[$i]) {
1215                 # subject not in aut, chosen to force anway
1216                 # so insert into cataloguentry so its in auth file
1217                 $query = "Insert into catalogueentry
1218                                 (entrytype,catalogueentry)
1219                             values ('s','$subject[$i]')";
1220          my $sth2 = $dbh->prepare($query);
1221
1222          $sth2->execute;
1223          $sth2->finish;
1224       } else {
1225         $error = "$subject[$i]\n does not exist in the subject authority file";
1226         $query = "Select * from catalogueentry
1227                             where entrytype = 's'
1228                             and (catalogueentry like '$subject[$i] %'
1229                                  or catalogueentry like '% $subject[$i] %'
1230                                  or catalogueentry like '% $subject[$i]')";
1231         my $sth2 = $dbh->prepare($query);
1232
1233         $sth2->execute;
1234         while (my $data = $sth2->fetchrow_hashref) {
1235           $error .= "<br>$data->{'catalogueentry'}";
1236         } # while
1237         $sth2->finish;
1238       } # else
1239     } # else
1240     $sth->finish;
1241   } # else
1242   if ($error eq '') {
1243     my $query = "Delete from bibliosubject where biblionumber = $bibnum";
1244     my $sth   = $dbh->prepare($query);
1245     $sth->execute;
1246     $sth->finish;
1247     for (my $i = 0; $i < $count; $i++) {
1248       $sth = $dbh->prepare("Insert into bibliosubject
1249                             values ('$subject[$i]', $bibnum)");
1250
1251       $sth->execute;
1252       $sth->finish;
1253     } # for
1254   } # if
1255
1256 #  $dbh->disconnect;
1257   return($error);
1258 } # sub modsubject
1259
1260 sub OLDmodbibitem {
1261     my ($dbh,$biblioitem) = @_;
1262 #    my $dbh   = C4Connect;
1263     my $query;
1264
1265     $biblioitem->{'itemtype'}        = $dbh->quote($biblioitem->{'itemtype'});
1266     $biblioitem->{'url'}             = $dbh->quote($biblioitem->{'url'});
1267     $biblioitem->{'isbn'}            = $dbh->quote($biblioitem->{'isbn'});
1268     $biblioitem->{'publishercode'}   = $dbh->quote($biblioitem->{'publishercode'});
1269     $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1270     $biblioitem->{'classification'}  = $dbh->quote($biblioitem->{'classification'});
1271     $biblioitem->{'dewey'}           = $dbh->quote($biblioitem->{'dewey'});
1272     $biblioitem->{'subclass'}        = $dbh->quote($biblioitem->{'subclass'});
1273     $biblioitem->{'illus'}           = $dbh->quote($biblioitem->{'illus'});
1274     $biblioitem->{'pages'}           = $dbh->quote($biblioitem->{'pages'});
1275     $biblioitem->{'volumeddesc'}     = $dbh->quote($biblioitem->{'volumeddesc'});
1276     $biblioitem->{'notes'}           = $dbh->quote($biblioitem->{'notes'});
1277     $biblioitem->{'size'}            = $dbh->quote($biblioitem->{'size'});
1278     $biblioitem->{'place'}           = $dbh->quote($biblioitem->{'place'});
1279
1280     $query = "Update biblioitems set
1281 itemtype        = $biblioitem->{'itemtype'},
1282 url             = $biblioitem->{'url'},
1283 isbn            = $biblioitem->{'isbn'},
1284 publishercode   = $biblioitem->{'publishercode'},
1285 publicationyear = $biblioitem->{'publicationyear'},
1286 classification  = $biblioitem->{'classification'},
1287 dewey           = $biblioitem->{'dewey'},
1288 subclass        = $biblioitem->{'subclass'},
1289 illus           = $biblioitem->{'illus'},
1290 pages           = $biblioitem->{'pages'},
1291 volumeddesc     = $biblioitem->{'volumeddesc'},
1292 notes           = $biblioitem->{'notes'},
1293 size            = $biblioitem->{'size'},
1294 place           = $biblioitem->{'place'}
1295 where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
1296
1297     $dbh->do($query);
1298
1299 #    $dbh->disconnect;
1300 } # sub modbibitem
1301
1302 sub OLDmodnote {
1303   my ($dbh,$bibitemnum,$note)=@_;
1304 #  my $dbh=C4Connect;
1305   my $query="update biblioitems set notes='$note' where
1306   biblioitemnumber='$bibitemnum'";
1307   my $sth=$dbh->prepare($query);
1308   $sth->execute;
1309   $sth->finish;
1310 #  $dbh->disconnect;
1311 }
1312
1313 sub OLDnewbiblioitem {
1314     my ($dbh,$biblioitem) = @_;
1315 #  my $dbh   = C4Connect;
1316     my $query = "Select max(biblioitemnumber) from biblioitems";
1317     my $sth   = $dbh->prepare($query);
1318     my $data;
1319     my $bibitemnum;
1320
1321     $biblioitem->{'volume'}          = $dbh->quote($biblioitem->{'volume'});
1322     $biblioitem->{'number'}        = $dbh->quote($biblioitem->{'number'});
1323     $biblioitem->{'classification'}  = $dbh->quote($biblioitem->{'classification'});
1324     $biblioitem->{'itemtype'}        = $dbh->quote($biblioitem->{'itemtype'});
1325     $biblioitem->{'url'}             = $dbh->quote($biblioitem->{'url'});
1326     $biblioitem->{'isbn'}            = $dbh->quote($biblioitem->{'isbn'});
1327     $biblioitem->{'issn'}            = $dbh->quote($biblioitem->{'issn'});
1328     $biblioitem->{'dewey'}           = $dbh->quote($biblioitem->{'dewey'});
1329     $biblioitem->{'subclass'}        = $dbh->quote($biblioitem->{'subclass'});
1330     $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'});
1331     $biblioitem->{'publishercode'}   = $dbh->quote($biblioitem->{'publishercode'});
1332     $biblioitem->{'volumedate'}      = $dbh->quote($biblioitem->{'volumedate'});
1333     $biblioitem->{'volumeddesc'}     = $dbh->quote($biblioitem->{'volumeddesc'});  $biblioitem->{'illus'}            = $dbh->quote($biblioitem->{'illus'});
1334     $biblioitem->{'illus'}         = $dbh->quote($biblioitem->{'illus'});
1335     $biblioitem->{'pages'}           = $dbh->quote($biblioitem->{'pages'});
1336     $biblioitem->{'notes'}           = $dbh->quote($biblioitem->{'notes'});
1337     $biblioitem->{'size'}            = $dbh->quote($biblioitem->{'size'});
1338     $biblioitem->{'place'}           = $dbh->quote($biblioitem->{'place'});
1339     $biblioitem->{'lccn'}            = $dbh->quote($biblioitem->{'lccn'});
1340     $biblioitem->{'marc'}            = $dbh->quote($biblioitem->{'marc'});
1341
1342     $sth->execute;
1343     $data       = $sth->fetchrow_arrayref;
1344     $bibitemnum = $$data[0] + 1;
1345
1346     $sth->finish;
1347
1348     $query = "insert into biblioitems set
1349                         biblioitemnumber = $bibitemnum,
1350                         biblionumber     = $biblioitem->{'biblionumber'},
1351                         volume           = $biblioitem->{'volume'},
1352                         number           = $biblioitem->{'number'},
1353                         classification   = $biblioitem->{'classification'},
1354                         itemtype         = $biblioitem->{'itemtype'},
1355                         url              = $biblioitem->{'url'},
1356                         isbn             = $biblioitem->{'isbn'},
1357                         issn             = $biblioitem->{'issn'},
1358                         dewey            = $biblioitem->{'dewey'},
1359                         subclass         = $biblioitem->{'subclass'},
1360                         publicationyear  = $biblioitem->{'publicationyear'},
1361                         publishercode    = $biblioitem->{'publishercode'},
1362                         volumedate       = $biblioitem->{'volumedate'},
1363                         volumeddesc      = $biblioitem->{'volumeddesc'},
1364                         illus            = $biblioitem->{'illus'},
1365                         pages            = $biblioitem->{'pages'},
1366                         notes            = $biblioitem->{'notes'},
1367                         size             = $biblioitem->{'size'},
1368                         lccn             = $biblioitem->{'lccn'},
1369                         marc             = $biblioitem->{'marc'},
1370                         place            = $biblioitem->{'place'}";
1371
1372     $sth = $dbh->prepare($query);
1373     $sth->execute;
1374     $sth->finish;
1375 #    $dbh->disconnect;
1376     return($bibitemnum);
1377 }
1378
1379 sub OLDnewsubject {
1380   my ($dbh,$bibnum)=@_;
1381 #  my $dbh=C4Connect;
1382   my $query="insert into bibliosubject (biblionumber) values
1383   ($bibnum)";
1384   my $sth=$dbh->prepare($query);
1385 #  print $query;
1386   $sth->execute;
1387   $sth->finish;
1388 #  $dbh->disconnect;
1389 }
1390
1391 sub OLDnewsubtitle {
1392     my ($dbh,$bibnum, $subtitle) = @_;
1393 #  my $dbh   = C4Connect;
1394     $subtitle = $dbh->quote($subtitle);
1395     my $query = "insert into bibliosubtitle set
1396                             biblionumber = $bibnum,
1397                             subtitle = $subtitle";
1398     my $sth   = $dbh->prepare($query);
1399
1400     $sth->execute;
1401
1402     $sth->finish;
1403 #  $dbh->disconnect;
1404 }
1405
1406
1407 sub OLDnewitems {
1408   my ($dbh,$item, $barcode) = @_;
1409 #  my $dbh   = C4Connect;
1410   my $query = "Select max(itemnumber) from items";
1411   my $sth   = $dbh->prepare($query);
1412   my $data;
1413   my $itemnumber;
1414   my $error = "";
1415
1416   $sth->execute;
1417   $data       = $sth->fetchrow_hashref;
1418   $itemnumber = $data->{'max(itemnumber)'} + 1;
1419   $sth->finish;
1420
1421   $item->{'booksellerid'}     = $dbh->quote($item->{'booksellerid'});
1422   $item->{'homebranch'}       = $dbh->quote($item->{'homebranch'});
1423   $item->{'price'}            = $dbh->quote($item->{'price'});
1424   $item->{'replacementprice'} = $dbh->quote($item->{'replacementprice'});
1425   $item->{'itemnotes'}        = $dbh->quote($item->{'itemnotes'});
1426
1427 #  foreach my $barcode (@barcodes) {
1428 #    $barcode = uc($barcode);
1429   $barcode = $dbh->quote($barcode);
1430   $query   = "Insert into items set
1431                             itemnumber           = $itemnumber,
1432                             biblionumber         = $item->{'biblionumber'},
1433                             biblioitemnumber     = $item->{'biblioitemnumber'},
1434                             barcode              = $barcode,
1435                             booksellerid         = $item->{'booksellerid'},
1436                             dateaccessioned      = NOW(),
1437                             homebranch           = $item->{'homebranch'},
1438                             holdingbranch        = $item->{'homebranch'},
1439                             price                = $item->{'price'},
1440                             replacementprice     = $item->{'replacementprice'},
1441                             replacementpricedate = NOW(),
1442                             itemnotes            = $item->{'itemnotes'}";
1443   if ($item->{'loan'}) {
1444       $query .= ",notforloan           = $item->{'loan'}";
1445   } # if
1446
1447   $sth = $dbh->prepare($query);
1448   $sth->execute;
1449   if (defined $sth->errstr) {
1450       $error .= $sth->errstr;
1451   }
1452   $sth->finish;
1453 #  $itemnumber++;
1454 #  $dbh->disconnect;
1455   return($itemnumber,$error);
1456 }
1457
1458 sub OLDmoditem {
1459     my ($dbh,$item) = @_;
1460 #  my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
1461 #  my $dbh=C4Connect;
1462   my $query="update items set biblioitemnumber=$item->{'bibitemnum'},
1463                               barcode='$item->{'barcode'}',itemnotes='$item->{'notes'}'
1464                           where itemnumber=$item->{'itemnum'}";
1465   if ($item->{'barcode'} eq ''){
1466     $query="update items set biblioitemnumber=$item->{'bibitemnum'},notforloan=$item->{'loan'} where itemnumber=$item->{'itemnum'}";
1467   }
1468   if ($item->{'lost'} ne ''){
1469     $query="update items set biblioitemnumber=$item->{'bibitemnum'},
1470                              barcode='$item->{'barcode'}',
1471                              itemnotes='$item->{'notes'}',
1472                              homebranch='$item->{'homebranch'}',
1473                              itemlost='$item->{'lost'}',
1474                              wthdrawn='$item->{'wthdrawn'}'
1475                           where itemnumber=$item->{'itemnum'}";
1476   }
1477   if ($item->{'replacement'} ne ''){
1478     $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1479   }
1480
1481   my $sth=$dbh->prepare($query);
1482   $sth->execute;
1483   $sth->finish;
1484 #  $dbh->disconnect;
1485 }
1486
1487 sub OLDdelitem{
1488   my ($dbh,$itemnum)=@_;
1489 #  my $dbh=C4Connect;
1490   my $query="select * from items where itemnumber=$itemnum";
1491   my $sth=$dbh->prepare($query);
1492   $sth->execute;
1493   my @data=$sth->fetchrow_array;
1494   $sth->finish;
1495   $query="Insert into deleteditems values (";
1496   foreach my $temp (@data){
1497     $query .= "'$temp',";
1498   }
1499   $query=~ s/\,$/\)/;
1500 #  print $query;
1501   $sth=$dbh->prepare($query);
1502   $sth->execute;
1503   $sth->finish;
1504   $query = "Delete from items where itemnumber=$itemnum";
1505   $sth=$dbh->prepare($query);
1506   $sth->execute;
1507   $sth->finish;
1508 #  $dbh->disconnect;
1509 }
1510
1511 sub OLDdeletebiblioitem {
1512     my ($dbh,$biblioitemnumber) = @_;
1513 #    my $dbh   = C4Connect;
1514     my $query = "Select * from biblioitems
1515 where biblioitemnumber = $biblioitemnumber";
1516     my $sth   = $dbh->prepare($query);
1517     my @results;
1518
1519     $sth->execute;
1520
1521     if (@results = $sth->fetchrow_array) {
1522         $query = "Insert into deletedbiblioitems values (";
1523         foreach my $value (@results) {
1524             $value  = $dbh->quote($value);
1525             $query .= "$value,";
1526         } # foreach
1527
1528         $query =~ s/\,$/\)/;
1529         $dbh->do($query);
1530
1531         $query = "Delete from biblioitems
1532                         where biblioitemnumber = $biblioitemnumber";
1533         $dbh->do($query);
1534     } # if
1535     $sth->finish;
1536 # Now delete all the items attached to the biblioitem
1537     $query = "Select * from items where biblioitemnumber = $biblioitemnumber";
1538     $sth   = $dbh->prepare($query);
1539     $sth->execute;
1540     while (@results = $sth->fetchrow_array) {
1541         $query = "Insert into deleteditems values (";
1542         foreach my $value (@results) {
1543             $value  = $dbh->quote($value);
1544             $query .= "$value,";
1545         } # foreach
1546         $query =~ s/\,$/\)/;
1547         $dbh->do($query);
1548     } # while
1549     $sth->finish;
1550     $query = "Delete from items where biblioitemnumber = $biblioitemnumber";
1551     $dbh->do($query);
1552 #    $dbh->disconnect;
1553 } # sub deletebiblioitem
1554
1555 sub OLDdelbiblio{
1556   my ($dbh,$biblio)=@_;
1557 #  my $dbh=C4Connect;
1558   my $query="select * from biblio where biblionumber=$biblio";
1559   my $sth=$dbh->prepare($query);
1560   $sth->execute;
1561   if (my @data=$sth->fetchrow_array){
1562     $sth->finish;
1563     $query="Insert into deletedbiblio values (";
1564     foreach my $temp (@data){
1565       $temp=~ s/\'/\\\'/g;
1566       $query .= "'$temp',";
1567     }
1568     $query=~ s/\,$/\)/;
1569 #   print $query;
1570     $sth=$dbh->prepare($query);
1571     $sth->execute;
1572     $sth->finish;
1573     $query = "Delete from biblio where biblionumber=$biblio";
1574     $sth=$dbh->prepare($query);
1575     $sth->execute;
1576     $sth->finish;
1577   }
1578   $sth->finish;
1579 #  $dbh->disconnect;
1580 }
1581
1582 #
1583 #
1584 # old functions
1585 #
1586 #
1587
1588 sub itemcount{
1589   my ($biblio)=@_;
1590   my $dbh = C4::Context->dbh;
1591   my $query="Select count(*) from items where biblionumber=$biblio";
1592 #  print $query;
1593   my $sth=$dbh->prepare($query);
1594   $sth->execute;
1595   my $data=$sth->fetchrow_hashref;
1596   $sth->finish;
1597   return($data->{'count(*)'});
1598 }
1599
1600 =item getorder
1601
1602   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
1603
1604 Looks up the order with the given biblionumber and biblioitemnumber.
1605
1606 Returns a two-element array. C<$ordernumber> is the order number.
1607 C<$order> is a reference-to-hash describing the order; its keys are
1608 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
1609 tables of the Koha database.
1610
1611 =cut
1612 #'
1613 # FIXME - This is effectively identical to &C4::Catalogue::getorder.
1614 # Pick one and stick with it.
1615 sub getorder{
1616   my ($bi,$bib)=@_;
1617   my $dbh = C4::Context->dbh;
1618   my $query="Select ordernumber
1619         from aqorders
1620         where biblionumber=? and biblioitemnumber=?";
1621   my $sth=$dbh->prepare($query);
1622   $sth->execute($bib,$bi);
1623   # FIXME - Use fetchrow_array(), since we're only interested in the one
1624   # value.
1625   my $ordnum=$sth->fetchrow_hashref;
1626   $sth->finish;
1627   my $order=getsingleorder($ordnum->{'ordernumber'});
1628 #  print $query;
1629   return ($order,$ordnum->{'ordernumber'});
1630 }
1631
1632 =item getsingleorder
1633
1634   $order = &getsingleorder($ordernumber);
1635
1636 Looks up an order by order number.
1637
1638 Returns a reference-to-hash describing the order. The keys of
1639 C<$order> are fields from the biblio, biblioitems, aqorders, and
1640 aqorderbreakdown tables of the Koha database.
1641
1642 =cut
1643 #'
1644 # FIXME - This is effectively identical to
1645 # &C4::Catalogue::getsingleorder.
1646 # Pick one and stick with it.
1647 sub getsingleorder {
1648   my ($ordnum)=@_;
1649   my $dbh = C4::Context->dbh;
1650   my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
1651   where aqorders.ordernumber=?
1652   and biblio.biblionumber=aqorders.biblionumber and
1653   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
1654   aqorders.ordernumber=aqorderbreakdown.ordernumber";
1655   my $sth=$dbh->prepare($query);
1656   $sth->execute($ordnum);
1657   my $data=$sth->fetchrow_hashref;
1658   $sth->finish;
1659   return($data);
1660 }
1661
1662 sub newbiblio {
1663   my ($biblio) = @_;
1664   my $dbh    = C4::Context->dbh;
1665   my $bibnum=OLDnewbiblio($dbh,$biblio);
1666 # TODO : MARC add
1667   return($bibnum);
1668 }
1669
1670 =item modbiblio
1671
1672   $biblionumber = &modbiblio($biblio);
1673
1674 Update a biblio record.
1675
1676 C<$biblio> is a reference-to-hash whose keys are the fields in the
1677 biblio table in the Koha database. All fields must be present, not
1678 just the ones you wish to change.
1679
1680 C<&modbiblio> updates the record defined by
1681 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1682
1683 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1684 successful or not.
1685
1686 =cut
1687
1688 sub modbiblio {
1689   my ($biblio) = @_;
1690   my $dbh  = C4::Context->dbh;
1691   my $biblionumber=OLDmodbiblio($dbh,$biblio);
1692   return($biblionumber);
1693 } # sub modbiblio
1694
1695 =item modsubtitle
1696
1697   &modsubtitle($biblionumber, $subtitle);
1698
1699 Sets the subtitle of a book.
1700
1701 C<$biblionumber> is the biblionumber of the book to modify.
1702
1703 C<$subtitle> is the new subtitle.
1704
1705 =cut
1706
1707 sub modsubtitle {
1708   my ($bibnum, $subtitle) = @_;
1709   my $dbh   = C4::Context->dbh;
1710   &OLDmodsubtitle($dbh,$bibnum,$subtitle);
1711 } # sub modsubtitle
1712
1713 =item modaddauthor
1714
1715   &modaddauthor($biblionumber, $author);
1716
1717 Replaces all additional authors for the book with biblio number
1718 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1719 C<&modaddauthor> deletes all additional authors.
1720
1721 =cut
1722
1723 sub modaddauthor {
1724     my ($bibnum, $author) = @_;
1725     my $dbh   = C4::Context->dbh;
1726     &OLDmodaddauthor($dbh,$bibnum,$author);
1727 } # sub modaddauthor
1728
1729 =item modsubject
1730
1731   $error = &modsubject($biblionumber, $force, @subjects);
1732
1733 $force - a subject to force
1734
1735 $error - Error message, or undef if successful.
1736
1737 =cut
1738
1739 sub modsubject {
1740   my ($bibnum, $force, @subject) = @_;
1741   my $dbh   = C4::Context->dbh;
1742   my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject);
1743   return($error);
1744 } # sub modsubject
1745
1746 sub modbibitem {
1747     my ($biblioitem) = @_;
1748     my $dbh   = C4::Context->dbh;
1749     &OLDmodbibitem($dbh,$biblioitem);
1750     my $MARCbibitem = MARCkoha2marcBiblio($dbh,$biblioitem);
1751     &MARCmodbiblio($dbh,$biblioitem->{biblionumber},0,$MARCbibitem);
1752 } # sub modbibitem
1753
1754 sub modnote {
1755   my ($bibitemnum,$note)=@_;
1756   my $dbh = C4::Context->dbh;
1757   &OLDmodnote($dbh,$bibitemnum,$note);
1758 }
1759
1760 sub newbiblioitem {
1761   my ($biblioitem) = @_;
1762   my $dbh   = C4::Context->dbh;
1763   my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem);
1764 #  print STDERR "bibitemnum : $bibitemnum\n";
1765   my $MARCbiblio= MARCkoha2marcBiblio($dbh,$biblioitem->{biblionumber},$bibitemnum);
1766 #  print STDERR $MARCbiblio->as_formatted();
1767   &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber});
1768   return($bibitemnum);
1769 }
1770
1771 sub newsubject {
1772   my ($bibnum)=@_;
1773   my $dbh = C4::Context->dbh;
1774   &OLDnewsubject($dbh,$bibnum);
1775 }
1776
1777 sub newsubtitle {
1778     my ($bibnum, $subtitle) = @_;
1779     my $dbh   = C4::Context->dbh;
1780     &OLDnewsubtitle($dbh,$bibnum,$subtitle);
1781 }
1782
1783 sub newitems {
1784   my ($item, @barcodes) = @_;
1785   my $dbh   = C4::Context->dbh;
1786   my $errors;
1787   my $itemnumber;
1788   my $error;
1789   foreach my $barcode (@barcodes) {
1790       ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode));
1791       $errors .=$error;
1792       my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber);
1793       &MARCadditem($dbh,$MARCitem,$item->{biblionumber});
1794   }
1795   return($errors);
1796 }
1797
1798 sub moditem {
1799     my ($item) = @_;
1800     my $dbh = C4::Context->dbh;
1801     &OLDmoditem($dbh,$item);
1802     my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'});
1803     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber});
1804     &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0);
1805 }
1806
1807 sub checkitems{
1808   my ($count,@barcodes)=@_;
1809   my $dbh = C4::Context->dbh;
1810   my $error;
1811   for (my $i=0;$i<$count;$i++){
1812     $barcodes[$i]=uc $barcodes[$i];
1813     my $query="Select * from items where barcode='$barcodes[$i]'";
1814     my $sth=$dbh->prepare($query);
1815     $sth->execute;
1816     if (my $data=$sth->fetchrow_hashref){
1817       $error.=" Duplicate Barcode: $barcodes[$i]";
1818     }
1819     $sth->finish;
1820   }
1821   return($error);
1822 }
1823
1824 sub countitems{
1825   my ($bibitemnum)=@_;
1826   my $dbh = C4::Context->dbh;
1827   my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
1828   my $sth=$dbh->prepare($query);
1829   $sth->execute;
1830   my $data=$sth->fetchrow_hashref;
1831   $sth->finish;
1832   return($data->{'count(*)'});
1833 }
1834
1835 sub delitem{
1836   my ($itemnum)=@_;
1837   my $dbh = C4::Context->dbh;
1838   &OLDdelitem($dbh,$itemnum);
1839 }
1840
1841 sub deletebiblioitem {
1842     my ($biblioitemnumber) = @_;
1843     my $dbh   = C4::Context->dbh;
1844     &OLDdeletebiblioitem($dbh,$biblioitemnumber);
1845 } # sub deletebiblioitem
1846
1847
1848 sub delbiblio {
1849   my ($biblio)=@_;
1850   my $dbh = C4::Context->dbh;
1851   &OLDdelbiblio($dbh,$biblio);
1852 }
1853
1854 sub getitemtypes {
1855   my $dbh   = C4::Context->dbh;
1856   my $query = "select * from itemtypes";
1857   my $sth   = $dbh->prepare($query);
1858     # || die "Cannot prepare $query" . $dbh->errstr;
1859   my $count = 0;
1860   my @results;
1861
1862   $sth->execute;
1863     # || die "Cannot execute $query\n" . $sth->errstr;
1864   while (my $data = $sth->fetchrow_hashref) {
1865     $results[$count] = $data;
1866     $count++;
1867   } # while
1868
1869   $sth->finish;
1870   return($count, @results);
1871 } # sub getitemtypes
1872
1873 sub getbiblio {
1874     my ($biblionumber) = @_;
1875     my $dbh   = C4::Context->dbh;
1876     my $query = "Select * from biblio where biblionumber = $biblionumber";
1877     my $sth   = $dbh->prepare($query);
1878       # || die "Cannot prepare $query\n" . $dbh->errstr;
1879     my $count = 0;
1880     my @results;
1881
1882     $sth->execute;
1883       # || die "Cannot execute $query\n" . $sth->errstr;
1884     while (my $data = $sth->fetchrow_hashref) {
1885       $results[$count] = $data;
1886       $count++;
1887     } # while
1888
1889     $sth->finish;
1890     return($count, @results);
1891 } # sub getbiblio
1892
1893 sub getbiblioitem {
1894     my ($biblioitemnum) = @_;
1895     my $dbh   = C4::Context->dbh;
1896     my $query = "Select * from biblioitems where
1897 biblioitemnumber = $biblioitemnum";
1898     my $sth   = $dbh->prepare($query);
1899     my $count = 0;
1900     my @results;
1901
1902     $sth->execute;
1903
1904     while (my $data = $sth->fetchrow_hashref) {
1905         $results[$count] = $data;
1906         $count++;
1907     } # while
1908
1909     $sth->finish;
1910     return($count, @results);
1911 } # sub getbiblioitem
1912
1913 sub getbiblioitembybiblionumber {
1914     my ($biblionumber) = @_;
1915     my $dbh   = C4::Context->dbh;
1916     my $query = "Select * from biblioitems where biblionumber =
1917 $biblionumber";
1918     my $sth   = $dbh->prepare($query);
1919     my $count = 0;
1920     my @results;
1921
1922     $sth->execute;
1923
1924     while (my $data = $sth->fetchrow_hashref) {
1925         $results[$count] = $data;
1926         $count++;
1927     } # while
1928
1929     $sth->finish;
1930     return($count, @results);
1931 } # sub
1932
1933 sub getitemsbybiblioitem {
1934     my ($biblioitemnum) = @_;
1935     my $dbh   = C4::Context->dbh;
1936     my $query = "Select * from items, biblio where
1937 biblio.biblionumber = items.biblionumber and biblioitemnumber
1938 = $biblioitemnum";
1939     my $sth   = $dbh->prepare($query);
1940       # || die "Cannot prepare $query\n" . $dbh->errstr;
1941     my $count = 0;
1942     my @results;
1943
1944     $sth->execute;
1945       # || die "Cannot execute $query\n" . $sth->errstr;
1946     while (my $data = $sth->fetchrow_hashref) {
1947       $results[$count] = $data;
1948       $count++;
1949     } # while
1950
1951     $sth->finish;
1952     return($count, @results);
1953 } # sub getitemsbybiblioitem
1954
1955 sub isbnsearch {
1956     my ($isbn) = @_;
1957     my $dbh   = C4::Context->dbh;
1958     my $count = 0;
1959     my $query;
1960     my $sth;
1961     my @results;
1962
1963     $isbn  = $dbh->quote($isbn);
1964     $query = "Select distinct biblio.* from biblio, biblioitems where
1965 biblio.biblionumber = biblioitems.biblionumber
1966 and isbn = $isbn";
1967     $sth   = $dbh->prepare($query);
1968
1969     $sth->execute;
1970     while (my $data = $sth->fetchrow_hashref) {
1971         $results[$count] = $data;
1972         $count++;
1973     } # while
1974
1975     $sth->finish;
1976     return($count, @results);
1977 } # sub isbnsearch
1978
1979 #sub skip {
1980 # At the moment this is just a straight copy of the subject code.  Needs heavy
1981 # modification to work for additional authors, obviously.
1982 # Check for additional author changes
1983
1984 #    my $newadditionalauthor='';
1985 #    my $additionalauthors;
1986 #    foreach $newadditionalauthor (@{$biblio->{'additionalauthor'}}) {
1987 #       $additionalauthors->{$newadditionalauthor}=1;
1988 #       if ($origadditionalauthors->{$newadditionalauthor}) {
1989 #           $additionalauthors->{$newadditionalauthor}=2;
1990 #       } else {
1991 #           my $q_newadditionalauthor=$dbh->quote($newadditionalauthor);
1992 #           my $sth=$dbh->prepare("insert into biblioadditionalauthors (additionalauthor,biblionumber) values ($q_newadditionalauthor, $biblionumber)");
1993 #           $sth->execute;
1994 #           logchange('kohadb', 'add', 'biblio', 'additionalauthor', $newadditionalauthor);
1995 #           my $subfields;
1996 #           $subfields->{1}->{'Subfield_Mark'}='a';
1997 #           $subfields->{1}->{'Subfield_Value'}=$newadditionalauthor;
1998 #           my $tag='650';
1999 #           my $Record_ID;
2000 #           foreach $Record_ID (@marcrecords) {
2001 #               addTag($env, $Record_ID, $tag, ' ', ' ', $subfields);
2002 #               logchange('marc', 'add', $Record_ID, '650', 'a', $newadditionalauthor);
2003 #           }
2004 #       }
2005 #    }
2006 #    my $origadditionalauthor;
2007 #    foreach $origadditionalauthor (keys %$origadditionalauthors) {
2008 #       if ($additionalauthors->{$origadditionalauthor} == 1) {
2009 #           my $q_origadditionalauthor=$dbh->quote($origadditionalauthor);
2010 #           logchange('kohadb', 'delete', 'biblio', '$biblionumber', 'additionalauthor', $origadditionalauthor);
2011 #           my $sth=$dbh->prepare("delete from biblioadditionalauthors where biblionumber=$biblionumber and additionalauthor=$q_origadditionalauthor");
2012 #           $sth->execute;
2013 #       }
2014 #    }
2015 #
2016 #}
2017 #    $dbh->disconnect;
2018 #}
2019
2020 sub logchange {
2021 # Subroutine to log changes to databases
2022 # Eventually, this subroutine will be used to create a log of all changes made,
2023 # with the possibility of "undo"ing some changes
2024     my $database=shift;
2025     if ($database eq 'kohadb') {
2026         my $type=shift;
2027         my $section=shift;
2028         my $item=shift;
2029         my $original=shift;
2030         my $new=shift;
2031 #       print STDERR "KOHA: $type $section $item $original $new\n";
2032     } elsif ($database eq 'marc') {
2033         my $type=shift;
2034         my $Record_ID=shift;
2035         my $tag=shift;
2036         my $mark=shift;
2037         my $subfield_ID=shift;
2038         my $original=shift;
2039         my $new=shift;
2040 #       print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
2041     }
2042 }
2043
2044 #------------------------------------------------
2045
2046
2047 #---------------------------------------
2048 # Find a biblio entry, or create a new one if it doesn't exist.
2049 #  If a "subtitle" entry is in hash, add it to subtitle table
2050 sub getoraddbiblio {
2051         # input params
2052         my (
2053           $dbh,         # db handle
2054                         # FIXME - Unused argument
2055           $biblio,      # hash ref to fields
2056         )=@_;
2057
2058         # return
2059         my $biblionumber;
2060
2061         my $debug=0;
2062         my $sth;
2063         my $error;
2064
2065         #-----
2066         $dbh = C4::Context->dbh;
2067
2068         print "<PRE>Looking for biblio </PRE>\n" if $debug;
2069         $sth=$dbh->prepare("select biblionumber
2070                 from biblio
2071                 where title=? and author=?
2072                   and copyrightdate=? and seriestitle=?");
2073         $sth->execute(
2074                 $biblio->{title}, $biblio->{author},
2075                 $biblio->{copyright}, $biblio->{seriestitle} );
2076         if ($sth->rows) {
2077             ($biblionumber) = $sth->fetchrow;
2078             print "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
2079         } else {
2080             # Doesn't exist.  Add new one.
2081             print "<PRE>Adding biblio</PRE>\n" if $debug;
2082             ($biblionumber,$error)=&newbiblio($biblio);
2083             if ( $biblionumber ) {
2084               print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
2085               if ( $biblio->{subtitle} ) {
2086                 &newsubtitle($biblionumber,$biblio->{subtitle} );
2087               } # if subtitle
2088             } else {
2089                 print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
2090             } # if added
2091         }
2092
2093         return $biblionumber,$error;
2094
2095 } # sub getoraddbiblio
2096
2097 END { }       # module clean-up code here (global destructor)
2098
2099 =back
2100
2101 =head1 AUTHOR
2102
2103 Koha Developement team <info@koha.org>
2104
2105 =cut
2106