C4/Biblio.pm

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