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