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

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