C4/Biblio.pm

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