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, $login) = @_;
  53
  54   my $self = {};
  55
  56   if ($login ne "") {
  57     my %user_data = $main::auth->read_user($login);
  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(FH, "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($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     $rc = 0;
 124
 125     my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $myconfig{dbdriver})->parse_dbupdate_controls;
 126
 127     map({ $form->{$_} = $myconfig{$_} } qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
 128     dbconnect_vars($form, $form->{dbname});
 129     my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh);
 130     $dbh->disconnect;
 131
 132     if ($update_available) {
 133       $form->{"stylesheet"} = "lx-office-erp.css";
 134       $form->{"title"} = $main::locale->text("Dataset upgrade");
 135       $form->header();
 136       print $form->parse_html_template("dbupgrade/header");
 137
 138       $form->{dbupdate} = "db$myconfig{dbname}";
 139       $form->{ $form->{dbupdate} } = 1;
 140
 141       if ($form->{"show_dbupdate_warning"}) {
 142         print $form->parse_html_template("dbupgrade/warning");
 143         ::end_of_request();
 144       }
 145
 146       # update the tables
 147       if (!open(FH, ">" . $::lx_office_conf{paths}->{userspath} . "/nologin")) {
 148         $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
 149                                                       'Please verify that the directory "#1" is writeable by the webserver.',
 150                                                       $::lx_office_conf{paths}->{userspath}),
 151                                   'back_button' => 1);
 152       }
 153
 154       # required for Oracle
 155       $form->{dbdefault} = $sid;
 156
 157       # ignore HUP, QUIT in case the webserver times out
 158       $SIG{HUP}  = 'IGNORE';
 159       $SIG{QUIT} = 'IGNORE';
 160
 161       $self->dbupdate($form);
 162       $self->dbupdate2($form, $dbupdater);
 163       SL::DBUpgrade2->new(form => $::form, dbdriver => 'Pg', auth => 1)->apply_admin_dbupgrade_scripts(0);
 164
 165       close(FH);
 166
 167       # remove lock file
 168       unlink($::lx_office_conf{paths}->{userspath} . "/nologin");
 169
 170       my $menufile =
 171         $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
 172         $self->{"menustyle"} eq "neu" ? "menunew.pl" :
 173         $self->{"menustyle"} eq "js" ? "menujs.pl" :
 174         $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
 175         "menu.pl";
 176
 177       print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
 178
 179       $rc = -2;
 180     }
 181   }
 182
 183   $main::lxdebug->leave_sub();
 184
 185   return $rc;
 186 }
 187
 188 sub dbconnect_vars {
 189   $main::lxdebug->enter_sub();
 190
 191   my ($form, $db) = @_;
 192
 193   my %dboptions = (
 194         'Pg' => { 'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
 195                   'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
 196                   'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
 197                   'mm-dd-yy'   => 'set DateStyle to \'POSTGRES, US\'',
 198                   'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
 199                   'dd-mm-yy'   => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
 200                   'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
 201         },
 202         'Oracle' => {
 203           'yy-mm-dd'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
 204           'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
 205           'mm/dd/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
 206           'mm-dd-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
 207           'dd/mm/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/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
 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   my $form   = \%main::form;
 690
 691   # format dbconnect and dboptions string
 692   dbconnect_vars($self, $self->{dbname});
 693
 694   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 695
 696   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 697
 698   my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
 699   if ($dbh) {
 700     $self->create_employee_entry($form, $dbh, $self, 1);
 701     $dbh->disconnect();
 702   }
 703
 704   $main::lxdebug->leave_sub();
 705 }
 706
 707 sub create_employee_entry {
 708   $main::lxdebug->enter_sub();
 709
 710   my $self            = shift;
 711   my $form            = shift;
 712   my $dbh             = shift;
 713   my $myconfig        = shift;
 714   my $update_existing = shift;
 715
 716   if (!does_table_exist($dbh, 'employee')) {
 717     $main::lxdebug->leave_sub();
 718     return;
 719   }
 720
 721   # add login to employee table if it does not exist
 722   # no error check for employee table, ignore if it does not exist
 723   my ($id)  = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 724
 725   if (!$id) {
 726     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 727     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 728
 729   } elsif ($update_existing) {
 730     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
 731     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 732   }
 733
 734   $main::lxdebug->leave_sub();
 735 }
 736
 737 sub config_vars {
 738   $main::lxdebug->enter_sub();
 739
 740   my @conf = qw(address admin businessnumber company countrycode
 741     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 742     dbname dbuser dbpasswd email fax name numberformat password
 743     printer role sid signature stylesheet tel templates vclimit angebote
 744     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 745     taxnumber co_ustid duns menustyle template_format default_media
 746     default_printer_id copies show_form_details favorites
 747     pdonumber sdonumber hide_cvar_search_options mandatory_departments
 748     sepa_creditor_id);
 749
 750   $main::lxdebug->leave_sub();
 751
 752   return @conf;
 753 }
 754
 755 sub error {
 756   $main::lxdebug->enter_sub();
 757
 758   my ($self, $msg) = @_;
 759
 760   $main::lxdebug->show_backtrace();
 761
 762   if ($ENV{HTTP_USER_AGENT}) {
 763     print qq|Content-Type: text/html
 764
 765 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
 766
 767 <body bgcolor=ffffff>
 768
 769 <h2><font color=red>Error!</font></h2>
 770 <p><b>$msg</b>|;
 771
 772   }
 773
 774   die "Error: $msg\n";
 775
 776   $main::lxdebug->leave_sub();
 777 }
 778
 779 1;
 780