C4/Biblio.pm

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