C4/Biblio.pm

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