C4/Biblio.pm

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