C4/Biblio.pm

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