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
  40 #use SL::Auth;
  41 use SL::DBConnect;
  42 use SL::DBUpgrade2;
  43 use SL::DBUtils;
  44 use SL::Iconv;
  45 use SL::Inifile;
  46
  47 use strict;
  48
  49 sub new {
  50   $main::lxdebug->enter_sub();
  51
  52   my ($type, %params) = @_;
  53
  54   my $self = {};
  55
  56   if ($params{id} || $params{login}) {
  57     my %user_data = $main::auth->read_user(%params);
  58     map { $self->{$_} = $user_data{$_} } keys %user_data;
  59   }
  60
  61   $main::lxdebug->leave_sub();
  62
  63   bless $self, $type;
  64 }
  65
  66 sub country_codes {
  67   $main::lxdebug->enter_sub();
  68
  69   local *DIR;
  70
  71   my %cc       = ();
  72   my @language = ();
  73
  74   # scan the locale directory and read in the LANGUAGE files
  75   opendir(DIR, "locale");
  76
  77   my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
  78
  79   foreach my $dir (@dir) {
  80     next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE");
  81     @language = <$fh>;
  82     close $fh;
  83
  84     $cc{$dir} = "@language";
  85   }
  86
  87   closedir(DIR);
  88
  89   $main::lxdebug->leave_sub();
  90
  91   return %cc;
  92 }
  93
  94 sub login {
  95   $main::lxdebug->enter_sub();
  96
  97   my ($self, $form) = @_;
  98   our $sid;
  99
 100   local *FH;
 101
 102   my $rc = -3;
 103
 104   if ($self->{login}) {
 105     my %myconfig = $main::auth->read_user(login => $self->{login});
 106
 107     # check if database is down
 108     my $dbh = SL::DBConnect->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd})
 109       or $self->error($DBI::errstr);
 110
 111     # we got a connection, check the version
 112     my $query = qq|SELECT version FROM defaults|;
 113     my $sth   = $dbh->prepare($query);
 114     $sth->execute || $form->dberror($query);
 115
 116     my ($dbversion) = $sth->fetchrow_array;
 117     $sth->finish;
 118
 119     $self->create_employee_entry($form, $dbh, \%myconfig);
 120
 121     $self->create_schema_info_table($form, $dbh);
 122
 123     my $dbupdater_auth = SL::DBUpgrade2->new(form => $form, dbdriver => 'Pg', auth => 1)->parse_dbupdate_controls;
 124     if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) {
 125       $::lxdebug->leave_sub;
 126       return -3;
 127     }
 128
 129     $rc = 0;
 130
 131     my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $myconfig{dbdriver})->parse_dbupdate_controls;
 132
 133     map({ $form->{$_} = $myconfig{$_} } qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
 134     dbconnect_vars($form, $form->{dbname});
 135     my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh);
 136     $dbh->disconnect;
 137
 138     if ($update_available) {
 139       $form->{"title"} = $main::locale->text("Dataset upgrade");
 140       $form->header();
 141       print $form->parse_html_template("dbupgrade/header");
 142
 143       $form->{dbupdate} = "db$myconfig{dbname}";
 144       $form->{ $form->{dbupdate} } = 1;
 145
 146       if ($form->{"show_dbupdate_warning"}) {
 147         print $form->parse_html_template("dbupgrade/warning");
 148         ::end_of_request();
 149       }
 150
 151       # update the tables
 152       if (!$::lx_office_conf{debug}->{keep_installation_unlocked} && !open(FH, ">", $::lx_office_conf{paths}->{userspath} . "/nologin")) {
 153         $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
 154                                                       'Please verify that the directory "#1" is writeable by the webserver.',
 155                                                       $::lx_office_conf{paths}->{userspath}),
 156                                   'back_button' => 1);
 157       }
 158
 159       # required for Oracle
 160       $form->{dbdefault} = $sid;
 161
 162       # ignore HUP, QUIT in case the webserver times out
 163       $SIG{HUP}  = 'IGNORE';
 164       $SIG{QUIT} = 'IGNORE';
 165
 166       $self->dbupdate($form);
 167       $self->dbupdate2($form, $dbupdater);
 168       SL::DBUpgrade2->new(form => $::form, dbdriver => 'Pg', auth => 1)->apply_admin_dbupgrade_scripts(0);
 169
 170       close(FH);
 171
 172       # remove lock file
 173       unlink($::lx_office_conf{paths}->{userspath} . "/nologin");
 174
 175       print $form->parse_html_template("dbupgrade/footer");
 176
 177       $rc = -2;
 178     }
 179   }
 180
 181   $main::lxdebug->leave_sub();
 182
 183   return $rc;
 184 }
 185
 186 sub dbconnect_vars {
 187   $main::lxdebug->enter_sub();
 188
 189   my ($form, $db) = @_;
 190
 191   my %dboptions = (
 192         'Pg' => { 'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
 193                   'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
 194                   'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
 195                   'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
 196                   'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
 197         },
 198         'Oracle' => {
 199           'yy-mm-dd'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
 200           'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
 201           'mm/dd/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
 202           'dd/mm/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
 203           'dd.mm.yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
 204         });
 205
 206   $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
 207
 208   if ($form->{dbdriver} eq 'Pg') {
 209     $form->{dbconnect} = "dbi:Pg:dbname=$db";
 210   }
 211
 212   if ($form->{dbdriver} eq 'Oracle') {
 213     $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
 214   }
 215
 216   if ($form->{dbhost}) {
 217     $form->{dbconnect} .= ";host=$form->{dbhost}";
 218   }
 219   if ($form->{dbport}) {
 220     $form->{dbconnect} .= ";port=$form->{dbport}";
 221   }
 222
 223   $main::lxdebug->leave_sub();
 224 }
 225
 226 sub dbdrivers {
 227   $main::lxdebug->enter_sub();
 228
 229   my @drivers = DBI->available_drivers();
 230
 231   $main::lxdebug->leave_sub();
 232
 233   return (grep { /(Pg|Oracle)/ } @drivers);
 234 }
 235
 236 sub dbsources {
 237   $main::lxdebug->enter_sub();
 238
 239   my ($self, $form) = @_;
 240
 241   my @dbsources = ();
 242   my ($sth, $query);
 243
 244   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
 245   $form->{sid} = $form->{dbdefault};
 246   &dbconnect_vars($form, $form->{dbdefault});
 247
 248   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 249     or $form->dberror;
 250
 251   if ($form->{dbdriver} eq 'Pg') {
 252     $query =
 253       qq|SELECT datname FROM pg_database | .
 254       qq|WHERE NOT datname IN ('template0', 'template1')|;
 255     $sth = $dbh->prepare($query);
 256     $sth->execute() || $form->dberror($query);
 257
 258     while (my ($db) = $sth->fetchrow_array) {
 259
 260       if ($form->{only_acc_db}) {
 261
 262         next if ($db =~ /^template/);
 263
 264         &dbconnect_vars($form, $db);
 265         my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 266           or $form->dberror;
 267
 268         $query =
 269           qq|SELECT tablename FROM pg_tables | .
 270           qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
 271         my $sth = $dbh->prepare($query);
 272         $sth->execute($form->{dbuser}) ||
 273           $form->dberror($query . " ($form->{dbuser})");
 274
 275         if ($sth->fetchrow_array) {
 276           push(@dbsources, $db);
 277         }
 278         $sth->finish;
 279         $dbh->disconnect;
 280         next;
 281       }
 282       push(@dbsources, $db);
 283     }
 284   }
 285
 286   if ($form->{dbdriver} eq 'Oracle') {
 287     if ($form->{only_acc_db}) {
 288       $query =
 289         qq|SELECT owner FROM dba_objects | .
 290         qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
 291     } else {
 292       $query = qq|SELECT username FROM dba_users|;
 293     }
 294
 295     $sth = $dbh->prepare($query);
 296     $sth->execute || $form->dberror($query);
 297
 298     while (my ($db) = $sth->fetchrow_array) {
 299       push(@dbsources, $db);
 300     }
 301   }
 302
 303   $sth->finish;
 304   $dbh->disconnect;
 305
 306   $main::lxdebug->leave_sub();
 307
 308   return @dbsources;
 309 }
 310
 311 sub dbclusterencoding {
 312   $main::lxdebug->enter_sub();
 313
 314   my ($self, $form) = @_;
 315
 316   $form->{dbdefault} ||= $form->{dbuser};
 317
 318   dbconnect_vars($form, $form->{dbdefault});
 319
 320   my $dbh                = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
 321   my $query              = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
 322   my ($cluster_encoding) = $dbh->selectrow_array($query);
 323   $dbh->disconnect();
 324
 325   $main::lxdebug->leave_sub();
 326
 327   return $cluster_encoding;
 328 }
 329
 330 sub dbcreate {
 331   $main::lxdebug->enter_sub();
 332
 333   my ($self, $form) = @_;
 334
 335   $form->{sid} = $form->{dbdefault};
 336   &dbconnect_vars($form, $form->{dbdefault});
 337   my $dbh =
 338     SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 339     or $form->dberror;
 340   $form->{db} =~ s/\"//g;
 341   my %dbcreate = (
 342     'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
 343     'Oracle' =>
 344     qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
 345     qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
 346   );
 347
 348   my %dboptions = (
 349     'Pg' => [],
 350   );
 351
 352   push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
 353     if ($form->{"encoding"});
 354   if ($form->{"dbdefault"}) {
 355     my $dbdefault = $form->{"dbdefault"};
 356     $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
 357     push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
 358   }
 359
 360   my $query = $dbcreate{$form->{dbdriver}};
 361   $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
 362
 363   # Ignore errors if the database exists.
 364   $dbh->do($query);
 365
 366   if ($form->{dbdriver} eq 'Oracle') {
 367     $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
 368     do_query($form, $dbh, $query);
 369   }
 370   $dbh->disconnect;
 371
 372   # setup variables for the new database
 373   if ($form->{dbdriver} eq 'Oracle') {
 374     $form->{dbuser}   = $form->{db};
 375     $form->{dbpasswd} = $form->{db};
 376   }
 377
 378   &dbconnect_vars($form, $form->{db});
 379
 380   $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 381     or $form->dberror;
 382
 383   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
 384   $db_charset ||= Common::DEFAULT_CHARSET;
 385
 386   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
 387   # create the tables
 388   $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
 389
 390   # load chart of accounts
 391   $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
 392
 393   $query = "UPDATE defaults SET coa = ?";
 394   do_query($form, $dbh, $query, $form->{chart});
 395   $query = "UPDATE defaults SET accounting_method = ?";
 396   do_query($form, $dbh, $query, $form->{accounting_method});
 397   $query = "UPDATE defaults SET profit_determination = ?";
 398   do_query($form, $dbh, $query, $form->{profit_determination});
 399   $query = "UPDATE defaults SET inventory_system = ?";
 400   do_query($form, $dbh, $query, $form->{inventory_system});
 401
 402   $dbh->disconnect;
 403
 404   $main::lxdebug->leave_sub();
 405 }
 406
 407 sub dbdelete {
 408   $main::lxdebug->enter_sub();
 409
 410   my ($self, $form) = @_;
 411   $form->{db} =~ s/\"//g;
 412   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 413                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
 414
 415   $form->{sid} = $form->{dbdefault};
 416   &dbconnect_vars($form, $form->{dbdefault});
 417   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 418     or $form->dberror;
 419   my $query = $dbdelete{$form->{dbdriver}};
 420   do_query($form, $dbh, $query);
 421
 422   $dbh->disconnect;
 423
 424   $main::lxdebug->leave_sub();
 425 }
 426
 427 sub dbsources_unused {
 428   $main::lxdebug->enter_sub();
 429
 430   my ($self, $form) = @_;
 431
 432   $form->{only_acc_db} = 1;
 433
 434   my %members = $main::auth->read_all_users();
 435   my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
 436
 437   $dbexcl{$form->{dbdefault}}             = 1;
 438   $dbexcl{$main::auth->{DB_config}->{db}} = 1;
 439
 440   my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
 441
 442   $main::lxdebug->leave_sub();
 443
 444   return @dbunused;
 445 }
 446
 447 sub dbneedsupdate {
 448   $main::lxdebug->enter_sub();
 449
 450   my ($self, $form) = @_;
 451
 452   my %members   = $main::auth->read_all_users();
 453   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
 454
 455   my ($query, $sth, %dbs_needing_updates);
 456
 457   foreach my $login (grep /[a-z]/, keys %members) {
 458     my $member = $members{$login};
 459
 460     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
 461     dbconnect_vars($form, $form->{dbname});
 462
 463     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
 464
 465     next unless $dbh;
 466
 467     my $version;
 468
 469     $query = qq|SELECT version FROM defaults|;
 470     $sth = prepare_query($form, $dbh, $query);
 471     if ($sth->execute()) {
 472       ($version) = $sth->fetchrow_array();
 473     }
 474     $sth->finish();
 475
 476     $dbh->disconnect and next unless $version;
 477
 478     my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
 479     $dbh->disconnect;
 480
 481    if ($update_available) {
 482       my $dbinfo = {};
 483       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
 484       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
 485     }
 486   }
 487
 488   $main::lxdebug->leave_sub();
 489
 490   return values %dbs_needing_updates;
 491 }
 492
 493 sub calc_version {
 494   $main::lxdebug->enter_sub(2);
 495
 496   my (@v, $version, $i);
 497
 498   @v = split(/\./, $_[0]);
 499   while (scalar(@v) < 4) {
 500     push(@v, 0);
 501   }
 502   $version = 0;
 503   for ($i = 0; $i < 4; $i++) {
 504     $version *= 1000;
 505     $version += $v[$i];
 506   }
 507
 508   $main::lxdebug->leave_sub(2);
 509   return $version;
 510 }
 511
 512 sub cmp_script_version {
 513   my ($a_from, $a_to, $b_from, $b_to);
 514   my ($i, $res_a, $res_b);
 515   my ($my_a, $my_b) = ($a, $b);
 516
 517   $my_a =~ s/.*-upgrade-//;
 518   $my_a =~ s/.sql$//;
 519   $my_b =~ s/.*-upgrade-//;
 520   $my_b =~ s/.sql$//;
 521   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
 522   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
 523
 524   $res_a = calc_version($my_a_from);
 525   $res_b = calc_version($my_b_from);
 526
 527   if ($res_a == $res_b) {
 528     $res_a = calc_version($my_a_to);
 529     $res_b = calc_version($my_b_to);
 530   }
 531
 532   return $res_a <=> $res_b;
 533 }
 534
 535 sub create_schema_info_table {
 536   $main::lxdebug->enter_sub();
 537
 538   my ($self, $form, $dbh) = @_;
 539
 540   my $query = "SELECT tag FROM schema_info LIMIT 1";
 541   if (!$dbh->do($query)) {
 542     $dbh->rollback();
 543     $query =
 544       qq|CREATE TABLE schema_info (| .
 545       qq|  tag text, | .
 546       qq|  login text, | .
 547       qq|  itime timestamp DEFAULT now(), | .
 548       qq|  PRIMARY KEY (tag))|;
 549     $dbh->do($query) || $form->dberror($query);
 550   }
 551
 552   $main::lxdebug->leave_sub();
 553 }
 554
 555 sub dbupdate {
 556   $main::lxdebug->enter_sub();
 557
 558   my ($self, $form) = @_;
 559
 560   local *SQLDIR;
 561
 562   $form->{sid} = $form->{dbdefault};
 563
 564   my @upgradescripts = ();
 565   my $query;
 566   my $rc = -2;
 567
 568   if ($form->{dbupdate}) {
 569
 570     # read update scripts into memory
 571     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
 572       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 573     @upgradescripts =
 574       sort(cmp_script_version
 575            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
 576                 readdir(SQLDIR)));
 577     closedir(SQLDIR);
 578   }
 579
 580   my $db_charset = $::lx_office_conf{system}->{dbcharset};
 581   $db_charset ||= Common::DEFAULT_CHARSET;
 582
 583   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
 584
 585   foreach my $db (split(/ /, $form->{dbupdate})) {
 586
 587     next unless $form->{$db};
 588
 589     # strip db from dataset
 590     $db =~ s/^db//;
 591     &dbconnect_vars($form, $db);
 592
 593     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 594       or $form->dberror;
 595
 596     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 597
 598     # check version
 599     $query = qq|SELECT version FROM defaults|;
 600     my ($version) = selectrow_query($form, $dbh, $query);
 601
 602     next unless $version;
 603
 604     $version = calc_version($version);
 605
 606     foreach my $upgradescript (@upgradescripts) {
 607       my $a = $upgradescript;
 608       $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
 609
 610       my ($mindb, $maxdb) = split /-/, $a;
 611       my $str_maxdb = $maxdb;
 612       $mindb = calc_version($mindb);
 613       $maxdb = calc_version($maxdb);
 614
 615       next if ($version >= $maxdb);
 616
 617       # if there is no upgrade script exit
 618       last if ($version < $mindb);
 619
 620       # apply upgrade
 621       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
 622       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 623
 624       $version = $maxdb;
 625
 626     }
 627
 628     $rc = 0;
 629     $dbh->disconnect;
 630
 631   }
 632
 633   $main::lxdebug->leave_sub();
 634
 635   return $rc;
 636 }
 637
 638 sub dbupdate2 {
 639   $main::lxdebug->enter_sub();
 640
 641   my ($self, $form, $dbupdater) = @_;
 642
 643   $form->{sid} = $form->{dbdefault};
 644
 645   my $rc         = -2;
 646   my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
 647
 648   map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
 649
 650   foreach my $db (split / /, $form->{dbupdate}) {
 651     next unless $form->{$db};
 652
 653     # strip db from dataset
 654     $db =~ s/^db//;
 655     &dbconnect_vars($form, $db);
 656
 657     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 658
 659     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 660
 661     $self->create_schema_info_table($form, $dbh);
 662
 663     my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
 664
 665     $dbh->disconnect and next if !@upgradescripts;
 666
 667     foreach my $control (@upgradescripts) {
 668       # apply upgrade
 669       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
 670       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 671
 672       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
 673     }
 674
 675     $rc = 0;
 676     $dbh->disconnect;
 677
 678   }
 679
 680   $main::lxdebug->leave_sub();
 681
 682   return $rc;
 683 }
 684
 685 sub save_member {
 686   $main::lxdebug->enter_sub();
 687
 688   my ($self) = @_;
 689
 690   # format dbconnect and dboptions string
 691   dbconnect_vars($self, $self->{dbname});
 692
 693   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 694
 695   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 696
 697   my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
 698   if ($dbh) {
 699     $self->create_employee_entry($::form, $dbh, $self, 1);
 700     $dbh->disconnect();
 701   }
 702
 703   $main::lxdebug->leave_sub();
 704 }
 705
 706 sub create_employee_entry {
 707   $main::lxdebug->enter_sub();
 708
 709   my $self            = shift;
 710   my $form            = shift;
 711   my $dbh             = shift;
 712   my $myconfig        = shift;
 713   my $update_existing = shift;
 714
 715   if (!does_table_exist($dbh, 'employee')) {
 716     $main::lxdebug->leave_sub();
 717     return;
 718   }
 719
 720   # add login to employee table if it does not exist
 721   # no error check for employee table, ignore if it does not exist
 722   my ($id)         = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 723   my ($good_db)    = selectrow_query($form, $dbh, qq|select * from pg_tables where tablename = ? and schemaname = ?|, 'schema_info', 'public');
 724   my  $can_delete;
 725      ($can_delete) = selectrow_query($form, $dbh, qq|SELECT tag FROM schema_info WHERE tag = ?|, 'employee_deleted') if $good_db;
 726
 727   if (!$id) {
 728     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 729     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 730
 731   } elsif ($update_existing && $can_delete) {
 732     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user', deleted = 'f' WHERE id = ?|;
 733     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 734   }
 735
 736   $main::lxdebug->leave_sub();
 737 }
 738
 739 sub config_vars {
 740   $main::lxdebug->enter_sub();
 741
 742   my @conf = qw(address admin businessnumber company countrycode
 743     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 744     dbname dbuser dbpasswd email fax name numberformat password
 745     printer sid signature stylesheet tel templates vclimit angebote
 746     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 747     taxnumber co_ustid duns menustyle template_format default_media
 748     default_printer_id copies show_form_details favorites
 749     pdonumber sdonumber hide_cvar_search_options mandatory_departments
 750     sepa_creditor_id taxincluded_checked);
 751
 752   $main::lxdebug->leave_sub();
 753
 754   return @conf;
 755 }
 756
 757 sub error {
 758   $main::lxdebug->enter_sub();
 759
 760   my ($self, $msg) = @_;
 761
 762   $main::lxdebug->show_backtrace();
 763
 764   if ($ENV{HTTP_USER_AGENT}) {
 765     print qq|Content-Type: text/html
 766
 767 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
 768
 769 <body bgcolor=ffffff>
 770
 771 <h2><font color=red>Error!</font></h2>
 772 <p><b>$msg</b>|;
 773
 774   }
 775
 776   die "Error: $msg\n";
 777
 778   $main::lxdebug->leave_sub();
 779 }
 780
 781 sub data {
 782   +{ %{ $_[0] } }
 783 }
 784
 785 1;