SL/User.pm

   1 #=====================================================================
   2 # LX-Office ERP
   3 # Copyright (C) 2004
   4 # Based on SQL-Ledger Version 2.1.9
   5 # Web http://www.lx-office.org
   6 #
   7 #=====================================================================
   8 # SQL-Ledger Accounting
   9 # Copyright (C) 2001
  10 #
  11 #  Author: Dieter Simader
  12 #   Email: dsimader@sql-ledger.org
  13 #     Web: http://www.sql-ledger.org
  14 #
  15 #  Contributors:
  16 #
  17 # This program is free software; you can redistribute it and/or modify
  18 # it under the terms of the GNU General Public License as published by
  19 # the Free Software Foundation; either version 2 of the License, or
  20 # (at your option) any later version.
  21 #
  22 # This program is distributed in the hope that it will be useful,
  23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25 # GNU General Public License for more details.
  26 # You should have received a copy of the GNU General Public License
  27 # along with this program; if not, write to the Free Software
  28 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29 #=====================================================================
  30 #
  31 # user related functions
  32 #
  33 #=====================================================================
  34
  35 package User;
  36
  37 use IO::File;
  38 use Fcntl qw(:seek);
  39 use Text::Iconv;
  40
  41 use SL::DBUpgrade2;
  42 use SL::DBUtils;
  43
  44 sub new {
  45   $main::lxdebug->enter_sub();
  46
  47   my ($type, $memfile, $login) = @_;
  48   my $self = {};
  49
  50   if ($login ne "") {
  51     &error("", "$memfile locked!") if (-f "${memfile}.LCK");
  52
  53     open(MEMBER, "$memfile") or &error("", "$memfile : $!");
  54
  55     while (<MEMBER>) {
  56       if (/^\[$login\]/) {
  57         while (<MEMBER>) {
  58           last if /^\[/;
  59           next if /^(#|\s)/;
  60
  61           # remove comments
  62           s/\s#.*//g;
  63
  64           # remove any trailing whitespace
  65           s/^\s*(.*?)\s*$/$1/;
  66
  67           ($key, $value) = split(/=/, $_, 2);
  68
  69           if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) {
  70             $value = "lx-office-erp.css";
  71           }
  72
  73           $self->{$key} = $value;
  74         }
  75
  76         $self->{login} = $login;
  77
  78         last;
  79       }
  80     }
  81     close MEMBER;
  82   }
  83
  84   $main::lxdebug->leave_sub();
  85   bless $self, $type;
  86 }
  87
  88 sub country_codes {
  89   $main::lxdebug->enter_sub();
  90
  91   my %cc       = ();
  92   my @language = ();
  93
  94   # scan the locale directory and read in the LANGUAGE files
  95   opendir(DIR, "locale");
  96
  97   my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
  98
  99   foreach my $dir (@dir) {
 100     next unless open(FH, "locale/$dir/LANGUAGE");
 101     @language = <FH>;
 102     close FH;
 103
 104     $cc{$dir} = "@language";
 105   }
 106
 107   closedir(DIR);
 108
 109   $main::lxdebug->leave_sub();
 110
 111   return %cc;
 112 }
 113
 114 sub login {
 115   $main::lxdebug->enter_sub();
 116
 117   my ($self, $form, $userspath) = @_;
 118
 119   my $rc = -3;
 120
 121   if ($self->{login}) {
 122
 123     if ($self->{password}) {
 124       if ($form->{hashed_password}) {
 125         $form->{password} = $form->{hashed_password};
 126       } else {
 127         $form->{password} = crypt($form->{password},
 128                                   substr($self->{login}, 0, 2));
 129       }
 130       if ($self->{password} ne $form->{password}) {
 131         $main::lxdebug->leave_sub();
 132         return -1;
 133       }
 134     }
 135
 136     unless (-e "$userspath/$self->{login}.conf") {
 137       $self->create_config("$userspath/$self->{login}.conf");
 138     }
 139
 140     do "$userspath/$self->{login}.conf";
 141     $myconfig{dbpasswd} = unpack('u', $myconfig{dbpasswd});
 142
 143     # check if database is down
 144     my $dbh =
 145       DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
 146                    $myconfig{dbpasswd})
 147       or $self->error(DBI::errstr);
 148
 149     # we got a connection, check the version
 150     my $query = qq|SELECT version FROM defaults|;
 151     my $sth   = $dbh->prepare($query);
 152     $sth->execute || $form->dberror($query);
 153
 154     my ($dbversion) = $sth->fetchrow_array;
 155     $sth->finish;
 156
 157     # add login to employee table if it does not exist
 158     # no error check for employee table, ignore if it does not exist
 159     $query = qq|SELECT id FROM employee WHERE login = ?|;
 160     my ($login) = selectrow_query($form, $dbh, $query, $self->{login});
 161
 162     if (!$login) {
 163       $query = qq|INSERT INTO employee (login, name, workphone, role)| .
 164                qq|VALUES (?, ?, ?, ?)|;
 165       my @values = ($self->{login}, $myconfig{name}, $myconfig{tel}, "user");
 166       do_query($form, $dbh, $query, @values);
 167     }
 168
 169     $self->create_schema_info_table($form, $dbh);
 170
 171     $dbh->disconnect;
 172
 173     $rc = 0;
 174
 175     my $controls =
 176       parse_dbupdate_controls($form, $myconfig{"dbdriver"});
 177
 178     map({ $form->{$_} = $myconfig{$_} }
 179         qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect));
 180
 181     if (update_available($myconfig{"dbdriver"}, $dbversion) ||
 182         update2_available($form, $controls)) {
 183
 184       $form->{"stylesheet"} = "lx-office-erp.css";
 185       $form->{"title"} = $main::locale->text("Dataset upgrade");
 186       $form->header();
 187       print($form->parse_html_template("dbupgrade/header"));
 188
 189       $form->{dbupdate} = "db$myconfig{dbname}";
 190       $form->{ $form->{dbupdate} } = 1;
 191
 192       if ($form->{"show_dbupdate_warning"}) {
 193         print($form->parse_html_template("dbupgrade/warning"));
 194         exit(0);
 195       }
 196
 197       # update the tables
 198       open(FH, ">$userspath/nologin") or die("$!");
 199
 200       # required for Oracle
 201       $form->{dbdefault} = $sid;
 202
 203       # ignore HUP, QUIT in case the webserver times out
 204       $SIG{HUP}  = 'IGNORE';
 205       $SIG{QUIT} = 'IGNORE';
 206
 207       $self->dbupdate($form);
 208       $self->dbupdate2($form, $controls);
 209
 210       # remove lock file
 211       unlink("$userspath/nologin");
 212
 213       my $menufile =
 214         $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
 215         $self->{"menustyle"} eq "neu" ? "menunew.pl" :
 216         "menu.pl";
 217
 218       print($form->parse_html_template("dbupgrade/footer",
 219                                        { "menufile" => $menufile }));
 220
 221       $rc = -2;
 222
 223     }
 224   }
 225
 226   $main::lxdebug->leave_sub();
 227
 228   return $rc;
 229 }
 230
 231 sub dbconnect_vars {
 232   $main::lxdebug->enter_sub();
 233
 234   my ($form, $db) = @_;
 235
 236   my %dboptions = (
 237         'Pg' => { 'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
 238                   'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
 239                   'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
 240                   'mm-dd-yy'   => 'set DateStyle to \'POSTGRES, US\'',
 241                   'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
 242                   'dd-mm-yy'   => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
 243                   'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
 244         },
 245         'Oracle' => {
 246           'yy-mm-dd'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
 247           'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
 248           'mm/dd/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
 249           'mm-dd-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
 250           'dd/mm/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
 251           'dd-mm-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
 252           'dd.mm.yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
 253         });
 254
 255   $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
 256
 257   if ($form->{dbdriver} eq 'Pg') {
 258     $form->{dbconnect} = "dbi:Pg:dbname=$db";
 259   }
 260
 261   if ($form->{dbdriver} eq 'Oracle') {
 262     $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
 263   }
 264
 265   if ($form->{dbhost}) {
 266     $form->{dbconnect} .= ";host=$form->{dbhost}";
 267   }
 268   if ($form->{dbport}) {
 269     $form->{dbconnect} .= ";port=$form->{dbport}";
 270   }
 271
 272   $main::lxdebug->leave_sub();
 273 }
 274
 275 sub dbdrivers {
 276   $main::lxdebug->enter_sub();
 277
 278   my @drivers = DBI->available_drivers();
 279
 280   $main::lxdebug->leave_sub();
 281
 282   return (grep { /(Pg|Oracle)/ } @drivers);
 283 }
 284
 285 sub dbsources {
 286   $main::lxdebug->enter_sub();
 287
 288   my ($self, $form) = @_;
 289
 290   my @dbsources = ();
 291   my ($sth, $query);
 292
 293   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
 294   $form->{sid} = $form->{dbdefault};
 295   &dbconnect_vars($form, $form->{dbdefault});
 296
 297   my $dbh =
 298     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 299     or $form->dberror;
 300
 301   if ($form->{dbdriver} eq 'Pg') {
 302     $query =
 303       qq|SELECT datname FROM pg_database | .
 304       qq|WHERE NOT datname IN ('template0', 'template1')|;
 305     $sth = $dbh->prepare($query);
 306     $sth->execute() || $form->dberror($query);
 307
 308     while (my ($db) = $sth->fetchrow_array) {
 309
 310       if ($form->{only_acc_db}) {
 311
 312         next if ($db =~ /^template/);
 313
 314         &dbconnect_vars($form, $db);
 315         my $dbh =
 316           DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 317           or $form->dberror;
 318
 319         $query =
 320           qq|SELECT tablename FROM pg_tables | .
 321           qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
 322         my $sth = $dbh->prepare($query);
 323         $sth->execute($form->{dbuser}) ||
 324           $form->dberror($query . " ($form->{dbuser})");
 325
 326         if ($sth->fetchrow_array) {
 327           push(@dbsources, $db);
 328         }
 329         $sth->finish;
 330         $dbh->disconnect;
 331         next;
 332       }
 333       push(@dbsources, $db);
 334     }
 335   }
 336
 337   if ($form->{dbdriver} eq 'Oracle') {
 338     if ($form->{only_acc_db}) {
 339       $query =
 340         qq|SELECT owner FROM dba_objects | .
 341         qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
 342     } else {
 343       $query = qq|SELECT username FROM dba_users|;
 344     }
 345
 346     $sth = $dbh->prepare($query);
 347     $sth->execute || $form->dberror($query);
 348
 349     while (my ($db) = $sth->fetchrow_array) {
 350       push(@dbsources, $db);
 351     }
 352   }
 353
 354   $sth->finish;
 355   $dbh->disconnect;
 356
 357   $main::lxdebug->leave_sub();
 358
 359   return @dbsources;
 360 }
 361
 362 sub dbcreate {
 363   $main::lxdebug->enter_sub();
 364
 365   my ($self, $form) = @_;
 366
 367   $form->{sid} = $form->{dbdefault};
 368   &dbconnect_vars($form, $form->{dbdefault});
 369   my $dbh =
 370     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 371     or $form->dberror;
 372   $form->{db} =~ s/\"//g;
 373   my %dbcreate = (
 374     'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
 375     'Oracle' =>
 376     qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
 377     qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
 378   );
 379
 380   my %dboptions = (
 381     'Pg' => [],
 382   );
 383
 384   push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
 385     if ($form->{"encoding"});
 386   if ($form->{"dbdefault"}) {
 387     my $dbdefault = $form->{"dbdefault"};
 388     $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
 389     push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
 390   }
 391
 392   my $query = $dbcreate{$form->{dbdriver}};
 393   $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
 394
 395   do_query($form, $dbh, $query);
 396
 397   if ($form->{dbdriver} eq 'Oracle') {
 398     $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
 399     do_query($form, $dbh, $query);
 400   }
 401   $dbh->disconnect;
 402
 403   # setup variables for the new database
 404   if ($form->{dbdriver} eq 'Oracle') {
 405     $form->{dbuser}   = $form->{db};
 406     $form->{dbpasswd} = $form->{db};
 407   }
 408
 409   &dbconnect_vars($form, $form->{db});
 410
 411   $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 412     or $form->dberror;
 413
 414   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
 415   $db_charset ||= Common::DEFAULT_CHARSET;
 416
 417   # create the tables
 418   $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
 419
 420   # load chart of accounts
 421   $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
 422
 423   $query = "UPDATE defaults SET coa = ?";
 424   do_query($form, $dbh, $query, $form->{chart});
 425
 426   $dbh->disconnect;
 427
 428   $main::lxdebug->leave_sub();
 429 }
 430
 431 # Process a Perl script which updates the database.
 432 # If the script returns 1 then the update was successful.
 433 # Return code "2" means "needs more interaction; remove
 434 # users/nologin and exit".
 435 # All other return codes are fatal errors.
 436 sub process_perl_script {
 437   $main::lxdebug->enter_sub();
 438
 439   my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
 440
 441   my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
 442
 443   my $file_charset = Common::DEFAULT_CHARSET;
 444
 445   if (ref($version_or_control) eq "HASH") {
 446     $file_charset = $version_or_control->{charset};
 447
 448   } else {
 449     while (<$fh>) {
 450       last if !/^--/;
 451       next if !/^--\s*\@charset:\s*(.+)/;
 452       $file_charset = $1;
 453       last;
 454     }
 455     $fh->seek(0, SEEK_SET);
 456   }
 457
 458   my $contents = join "", <$fh>;
 459   $fh->close();
 460
 461   $db_charset ||= Common::DEFAULT_CHARSET;
 462
 463   my $iconv = Text::Iconv->new($file_charset, $db_charset);
 464
 465   $dbh->begin_work();
 466
 467   my %dbup_myconfig = ();
 468   map({ $dbup_myconfig{$_} = $form->{$_}; }
 469       qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
 470
 471   my $nls_file = $filename;
 472   $nls_file =~ s|.*/||;
 473   $nls_file =~ s|.pl$||;
 474   my $dbup_locale = Locale->new($main::language, $nls_file);
 475
 476   my $result = eval($contents);
 477
 478   if (1 != $result) {
 479     $dbh->rollback();
 480     $dbh->disconnect();
 481   }
 482
 483   if (!defined($result)) {
 484     print($form->parse_html_template("dbupgrade/error",
 485                                      { "file" => $filename,
 486                                        "error" => $@ }));
 487     exit(0);
 488   } elsif (1 != $result) {
 489     unlink("users/nologin") if (2 == $result);
 490     exit(0);
 491   }
 492
 493   if (ref($version_or_control) eq "HASH") {
 494     $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
 495              $dbh->quote($version_or_control->{"tag"}) . ", " .
 496              $dbh->quote($form->{"login"}) . ")");
 497   } elsif ($version_or_control) {
 498     $dbh->do("UPDATE defaults SET version = " .
 499              $dbh->quote($version_or_control));
 500   }
 501   $dbh->commit();
 502
 503   $main::lxdebug->leave_sub();
 504 }
 505
 506 sub process_query {
 507   $main::lxdebug->enter_sub();
 508
 509   my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
 510
 511   my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
 512   my $query = "";
 513   my $sth;
 514   my @quote_chars;
 515
 516   my $file_charset = Common::DEFAULT_CHARSET;
 517   while (<$fh>) {
 518     last if !/^--/;
 519     next if !/^--\s*\@charset:\s*(.+)/;
 520     $file_charset = $1;
 521     last;
 522   }
 523   $fh->seek(0, SEEK_SET);
 524
 525   $db_charset ||= Common::DEFAULT_CHARSET;
 526
 527   my $iconv = Text::Iconv->new($file_charset, $db_charset);
 528
 529   $dbh->begin_work();
 530
 531   while (<$fh>) {
 532     $_ = $iconv->convert($_);
 533
 534     # Remove DOS and Unix style line endings.
 535     chomp;
 536
 537     # remove comments
 538     s/--.*$//;
 539
 540     for (my $i = 0; $i < length($_); $i++) {
 541       my $char = substr($_, $i, 1);
 542
 543       # Are we inside a string?
 544       if (@quote_chars) {
 545         if ($char eq $quote_chars[-1]) {
 546           pop(@quote_chars);
 547         }
 548         $query .= $char;
 549
 550       } else {
 551         if (($char eq "'") || ($char eq "\"")) {
 552           push(@quote_chars, $char);
 553
 554         } elsif ($char eq ";") {
 555
 556           # Query is complete. Send it.
 557
 558           $sth = $dbh->prepare($query);
 559           if (!$sth->execute()) {
 560             my $errstr = $dbh->errstr;
 561             $sth->finish();
 562             $dbh->rollback();
 563             $form->dberror("The database update/creation did not succeed. " .
 564                            "The file ${filename} containing the following " .
 565                            "query failed:<br>${query}<br>" .
 566                            "The error message was: ${errstr}<br>" .
 567                            "All changes in that file have been reverted.");
 568           }
 569           $sth->finish();
 570
 571           $char  = "";
 572           $query = "";
 573         }
 574
 575         $query .= $char;
 576       }
 577     }
 578   }
 579
 580   if (ref($version_or_control) eq "HASH") {
 581     $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
 582              $dbh->quote($version_or_control->{"tag"}) . ", " .
 583              $dbh->quote($form->{"login"}) . ")");
 584   } elsif ($version_or_control) {
 585     $dbh->do("UPDATE defaults SET version = " .
 586              $dbh->quote($version_or_control));
 587   }
 588   $dbh->commit();
 589
 590   $fh->close();
 591
 592   $main::lxdebug->leave_sub();
 593 }
 594
 595 sub dbdelete {
 596   $main::lxdebug->enter_sub();
 597
 598   my ($self, $form) = @_;
 599   $form->{db} =~ s/\"//g;
 600   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 601                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
 602
 603   $form->{sid} = $form->{dbdefault};
 604   &dbconnect_vars($form, $form->{dbdefault});
 605   my $dbh =
 606     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 607     or $form->dberror;
 608   my $query = $dbdelete{$form->{dbdriver}};
 609   do_query($form, $dbh, $query);
 610
 611   $dbh->disconnect;
 612
 613   $main::lxdebug->leave_sub();
 614 }
 615
 616 sub dbsources_unused {
 617   $main::lxdebug->enter_sub();
 618
 619   my ($self, $form, $memfile) = @_;
 620
 621   my @dbexcl    = ();
 622   my @dbsources = ();
 623
 624   $form->error('File locked!') if (-f "${memfile}.LCK");
 625
 626   # open members file
 627   open(FH, "$memfile") or $form->error("$memfile : $!");
 628
 629   while (<FH>) {
 630     if (/^dbname=/) {
 631       my ($null, $item) = split(/=/);
 632       push @dbexcl, $item;
 633     }
 634   }
 635
 636   close FH;
 637
 638   $form->{only_acc_db} = 1;
 639   my @db = &dbsources("", $form);
 640
 641   push @dbexcl, $form->{dbdefault};
 642
 643   foreach $item (@db) {
 644     unless (grep /$item$/, @dbexcl) {
 645       push @dbsources, $item;
 646     }
 647   }
 648
 649   $main::lxdebug->leave_sub();
 650
 651   return @dbsources;
 652 }
 653
 654 sub dbneedsupdate {
 655   $main::lxdebug->enter_sub();
 656
 657   my ($self, $form) = @_;
 658
 659   my %dbsources = ();
 660   my $query;
 661
 662   $form->{sid} = $form->{dbdefault};
 663   &dbconnect_vars($form, $form->{dbdefault});
 664
 665   my $dbh =
 666     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 667     or $form->dberror;
 668
 669   if ($form->{dbdriver} eq 'Pg') {
 670
 671     $query =
 672       qq|SELECT d.datname FROM pg_database d, pg_user u | .
 673       qq|WHERE d.datdba = u.usesysid AND u.usename = ?|;
 674     my $sth = prepare_execute_query($form, $dbh, $query, $form->{dbuser});
 675
 676     while (my ($db) = $sth->fetchrow_array) {
 677
 678       next if ($db =~ /^template/);
 679
 680       &dbconnect_vars($form, $db);
 681
 682       my $dbh2 =
 683         DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 684         or $form->dberror;
 685
 686       $query =
 687         qq|SELECT tablename FROM pg_tables | .
 688         qq|WHERE tablename = 'defaults'|;
 689       my $sth2 = prepare_execute_query($form, $dbh, $query);
 690
 691       if ($sth2->fetchrow_array) {
 692         $query = qq|SELECT version FROM defaults|;
 693         my ($version) = selectrow_query($form, $dbh2, $query);
 694         $dbsources{$db} = $version;
 695       }
 696       $sth2->finish;
 697       $dbh2->disconnect;
 698     }
 699     $sth->finish;
 700   }
 701
 702   if ($form->{dbdriver} eq 'Oracle') {
 703     $query =
 704       qq|SELECT owner FROM dba_objects |.
 705       qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
 706
 707     $sth = $dbh->prepare($query);
 708     $sth->execute || $form->dberror($query);
 709
 710     while (my ($db) = $sth->fetchrow_array) {
 711
 712       $form->{dbuser} = $db;
 713       &dbconnect_vars($form, $db);
 714
 715       my $dbh =
 716         DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 717         or $form->dberror;
 718
 719       $query = qq|SELECT version FROM defaults|;
 720       my $sth = $dbh->prepare($query);
 721       $sth->execute;
 722
 723       if (my ($version) = $sth->fetchrow_array) {
 724         $dbsources{$db} = $version;
 725       }
 726       $sth->finish;
 727       $dbh->disconnect;
 728     }
 729     $sth->finish;
 730   }
 731
 732   $dbh->disconnect;
 733
 734   $main::lxdebug->leave_sub();
 735
 736   return %dbsources;
 737 }
 738
 739 sub calc_version {
 740   $main::lxdebug->enter_sub(2);
 741
 742   my (@v, $version, $i);
 743
 744   @v = split(/\./, $_[0]);
 745   while (scalar(@v) < 4) {
 746     push(@v, 0);
 747   }
 748   $version = 0;
 749   for ($i = 0; $i < 4; $i++) {
 750     $version *= 1000;
 751     $version += $v[$i];
 752   }
 753
 754   $main::lxdebug->leave_sub(2);
 755   return $version;
 756 }
 757
 758 sub cmp_script_version {
 759   my ($a_from, $a_to, $b_from, $b_to);
 760   my ($i, $res_a, $res_b);
 761   my ($my_a, $my_b) = ($a, $b);
 762
 763   $my_a =~ s/.*-upgrade-//;
 764   $my_a =~ s/.sql$//;
 765   $my_b =~ s/.*-upgrade-//;
 766   $my_b =~ s/.sql$//;
 767   ($my_a_from, $my_a_to) = split(/-/, $my_a);
 768   ($my_b_from, $my_b_to) = split(/-/, $my_b);
 769
 770   $res_a = calc_version($my_a_from);
 771   $res_b = calc_version($my_b_from);
 772
 773   if ($res_a == $res_b) {
 774     $res_a = calc_version($my_a_to);
 775     $res_b = calc_version($my_b_to);
 776   }
 777
 778   return $res_a <=> $res_b;
 779 }
 780
 781 sub update_available {
 782   my ($dbdriver, $cur_version) = @_;
 783
 784   opendir(SQLDIR, "sql/${dbdriver}-upgrade")
 785     or &error("", "sql/${dbdriver}-upgrade: $!");
 786   my @upgradescripts =
 787     grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/,
 788          readdir(SQLDIR));
 789   closedir(SQLDIR);
 790
 791   return ($#upgradescripts > -1);
 792 }
 793
 794 sub create_schema_info_table {
 795   $main::lxdebug->enter_sub();
 796
 797   my ($self, $form, $dbh) = @_;
 798
 799   my $query = "SELECT tag FROM schema_info LIMIT 1";
 800   if (!$dbh->do($query)) {
 801     $dbh->rollback();
 802     $query =
 803       qq|CREATE TABLE schema_info (| .
 804       qq|  tag text, | .
 805       qq|  login text, | .
 806       qq|  itime timestamp DEFAULT now(), | .
 807       qq|  PRIMARY KEY (tag))|;
 808     $dbh->do($query) || $form->dberror($query);
 809   }
 810
 811   $main::lxdebug->leave_sub();
 812 }
 813
 814 sub dbupdate {
 815   $main::lxdebug->enter_sub();
 816
 817   my ($self, $form) = @_;
 818
 819   $form->{sid} = $form->{dbdefault};
 820
 821   my @upgradescripts = ();
 822   my $query;
 823   my $rc = -2;
 824
 825   if ($form->{dbupdate}) {
 826
 827     # read update scripts into memory
 828     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
 829       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 830     @upgradescripts =
 831       sort(cmp_script_version
 832            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
 833                 readdir(SQLDIR)));
 834     closedir(SQLDIR);
 835   }
 836
 837   my $db_charset = $main::dbcharset;
 838   $db_charset ||= Common::DEFAULT_CHARSET;
 839
 840   foreach my $db (split(/ /, $form->{dbupdate})) {
 841
 842     next unless $form->{$db};
 843
 844     # strip db from dataset
 845     $db =~ s/^db//;
 846     &dbconnect_vars($form, $db);
 847
 848     my $dbh =
 849       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 850       or $form->dberror;
 851
 852     # check version
 853     $query = qq|SELECT version FROM defaults|;
 854     my ($version) = selectrow_query($form, $dbh, $query);
 855
 856     next unless $version;
 857
 858     $version = calc_version($version);
 859
 860     foreach my $upgradescript (@upgradescripts) {
 861       my $a = $upgradescript;
 862       $a =~ s/^$form->{dbdriver}-upgrade-|\.(sql|pl)$//g;
 863       my $file_type = $1;
 864
 865       my ($mindb, $maxdb) = split /-/, $a;
 866       my $str_maxdb = $maxdb;
 867       $mindb = calc_version($mindb);
 868       $maxdb = calc_version($maxdb);
 869
 870       next if ($version >= $maxdb);
 871
 872       # if there is no upgrade script exit
 873       last if ($version < $mindb);
 874
 875       # apply upgrade
 876       $main::lxdebug->message(DEBUG2, "Applying Update $upgradescript");
 877       if ($file_type eq "sql") {
 878         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
 879                              "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 880       } else {
 881         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 882                                    "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 883       }
 884
 885       $version = $maxdb;
 886
 887     }
 888
 889     $rc = 0;
 890     $dbh->disconnect;
 891
 892   }
 893
 894   $main::lxdebug->leave_sub();
 895
 896   return $rc;
 897 }
 898
 899 sub dbupdate2 {
 900   $main::lxdebug->enter_sub();
 901
 902   my ($self, $form, $controls) = @_;
 903
 904   $form->{sid} = $form->{dbdefault};
 905
 906   my @upgradescripts = ();
 907   my ($query, $sth, $tag);
 908   my $rc = -2;
 909
 910   @upgradescripts = sort_dbupdate_controls($controls);
 911
 912   my $db_charset = $main::dbcharset;
 913   $db_charset ||= Common::DEFAULT_CHARSET;
 914
 915   my %converters;
 916
 917   foreach my $db (split / /, $form->{dbupdate}) {
 918
 919     next unless $form->{$db};
 920
 921     # strip db from dataset
 922     $db =~ s/^db//;
 923     &dbconnect_vars($form, $db);
 924
 925     my $dbh =
 926       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 927       or $form->dberror;
 928
 929     map({ $_->{"applied"} = 0; } @upgradescripts);
 930
 931     $query = qq|SELECT tag FROM schema_info|;
 932     $sth = $dbh->prepare($query);
 933     $sth->execute() || $form->dberror($query);
 934     while (($tag) = $sth->fetchrow_array()) {
 935       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 936     }
 937     $sth->finish();
 938
 939     my $all_applied = 1;
 940     foreach (@upgradescripts) {
 941       if (!$_->{"applied"}) {
 942         $all_applied = 0;
 943         last;
 944       }
 945     }
 946
 947     next if ($all_applied);
 948
 949     foreach my $control (@upgradescripts) {
 950       next if ($control->{"applied"});
 951
 952       if (!$converters{$control->{charset}}) {
 953         $converters{$control->{charset}} = Text::Iconv->new($control->{charset}, $db_charset);
 954       }
 955       $control->{description} = $converters{$control->{charset}}->convert($control->{description});
 956
 957       $control->{"file"} =~ /\.(sql|pl)$/;
 958       my $file_type = $1;
 959
 960       # apply upgrade
 961       $main::lxdebug->message(DEBUG2, "Applying Update $control->{file}");
 962       print($form->parse_html_template("dbupgrade/upgrade_message2",
 963                                        $control));
 964
 965       if ($file_type eq "sql") {
 966         $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
 967                              "-upgrade2/$control->{file}", $control, $db_charset);
 968       } else {
 969         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 970                                    "-upgrade2/$control->{file}", $control, $db_charset);
 971       }
 972     }
 973
 974     $rc = 0;
 975     $dbh->disconnect;
 976
 977   }
 978
 979   $main::lxdebug->leave_sub();
 980
 981   return $rc;
 982 }
 983
 984 sub update2_available {
 985   $main::lxdebug->enter_sub();
 986
 987   my ($form, $controls) = @_;
 988
 989   map({ $_->{"applied"} = 0; } values(%{$controls}));
 990
 991   dbconnect_vars($form, $form->{"dbname"});
 992
 993   my $dbh =
 994     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
 995     $form->dberror;
 996
 997   my ($query, $tag, $sth);
 998
 999   $query = qq|SELECT tag FROM schema_info|;
1000   $sth = $dbh->prepare($query);
1001   $sth->execute() || $form->dberror($query);
1002   while (($tag) = $sth->fetchrow_array()) {
1003     $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
1004   }
1005   $sth->finish();
1006   $dbh->disconnect();
1007
1008   map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
1009       values(%{$controls}));
1010
1011   $main::lxdebug->leave_sub();
1012   return 0;
1013 }
1014
1015 sub create_config {
1016   $main::lxdebug->enter_sub();
1017
1018   my ($self, $filename) = @_;
1019
1020   @config = &config_vars;
1021
1022   open(CONF, ">$filename") or $self->error("$filename : $!");
1023
1024   # create the config file
1025   print CONF qq|# configuration file for $self->{login}
1026
1027 \%myconfig = (
1028 |;
1029
1030   foreach $key (sort @config) {
1031     $self->{$key} =~ s/\'/\\\'/g;
1032     print CONF qq|  $key => '$self->{$key}',\n|;
1033   }
1034
1035   print CONF qq|);\n\n|;
1036
1037   close CONF;
1038
1039   $main::lxdebug->leave_sub();
1040 }
1041
1042 sub save_member {
1043   $main::lxdebug->enter_sub();
1044
1045   my ($self, $memberfile, $userspath) = @_;
1046
1047   my $newmember = 1;
1048
1049   # format dbconnect and dboptions string
1050   &dbconnect_vars($self, $self->{dbname});
1051
1052   $self->error('File locked!') if (-f "${memberfile}.LCK");
1053   open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
1054   close(FH);
1055
1056   open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
1057
1058   @config = <CONF>;
1059
1060   seek(CONF, 0, 0);
1061   truncate(CONF, 0);
1062
1063   while ($line = shift @config) {
1064     if ($line =~ /^\[$self->{login}\]/) {
1065       $newmember = 0;
1066       last;
1067     }
1068     print CONF $line;
1069   }
1070
1071   # remove everything up to next login or EOF
1072   while ($line = shift @config) {
1073     last if ($line =~ /^\[/);
1074   }
1075
1076   # this one is either the next login or EOF
1077   print CONF $line;
1078
1079   while ($line = shift @config) {
1080     print CONF $line;
1081   }
1082
1083   print CONF qq|[$self->{login}]\n|;
1084
1085   if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember)
1086       && $self->{root}) {
1087     $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
1088     chop $self->{dbpasswd};
1089   }
1090   if (defined($self->{new_password})) {
1091     if ($self->{new_password} ne $self->{old_password}) {
1092       $self->{password} = crypt $self->{new_password},
1093         substr($self->{login}, 0, 2)
1094         if $self->{new_password};
1095     }
1096   } else {
1097     if ($self->{password} ne $self->{old_password}) {
1098       $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2)
1099         if $self->{password};
1100     }
1101   }
1102
1103   if ($self->{'root login'}) {
1104     @config = ("password");
1105   } else {
1106     @config = &config_vars;
1107   }
1108
1109   # replace \r\n with \n
1110   map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature);
1111   foreach $key (sort @config) {
1112     print CONF qq|$key=$self->{$key}\n|;
1113   }
1114
1115   print CONF "\n";
1116   close CONF;
1117   unlink "${memberfile}.LCK";
1118
1119   # create conf file
1120   $self->create_config("$userspath/$self->{login}.conf")
1121     unless $self->{'root login'};
1122
1123   $main::lxdebug->leave_sub();
1124 }
1125
1126 sub config_vars {
1127   $main::lxdebug->enter_sub();
1128
1129   my @conf = qw(acs address admin businessnumber company countrycode
1130     currency dateformat dbconnect dbdriver dbhost dbport dboptions
1131     dbname dbuser dbpasswd email fax name numberformat password
1132     printer role sid signature stylesheet tel templates vclimit angebote
1133     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
1134     taxnumber co_ustid duns menustyle template_format default_media
1135     default_printer_id copies show_form_details);
1136
1137   $main::lxdebug->leave_sub();
1138
1139   return @conf;
1140 }
1141
1142 sub error {
1143   $main::lxdebug->enter_sub();
1144
1145   my ($self, $msg) = @_;
1146
1147   if ($ENV{HTTP_USER_AGENT}) {
1148     print qq|Content-Type: text/html
1149
1150 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
1151
1152 <body bgcolor=ffffff>
1153
1154 <h2><font color=red>Error!</font></h2>
1155 <p><b>$msg</b>|;
1156
1157   }
1158
1159   die "Error: $msg\n";
1160
1161   $main::lxdebug->leave_sub();
1162 }
1163
1164 1;
1165