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}, SL::DBConnect->get_options)
 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}, SL::DBConnect->get_options)
 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}, SL::DBConnect->get_options)
 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}, SL::DBConnect->get_options) || $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}, SL::DBConnect->get_options)
 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}, SL::DBConnect->get_options)
 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   $query = "UPDATE defaults SET curr = ?";
 402   do_query($form, $dbh, $query, $form->{defaultcurrency});
 403
 404   $dbh->disconnect;
 405
 406   $main::lxdebug->leave_sub();
 407 }
 408
 409 sub dbdelete {
 410   $main::lxdebug->enter_sub();
 411
 412   my ($self, $form) = @_;
 413   $form->{db} =~ s/\"//g;
 414   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 415                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
 416
 417   $form->{sid} = $form->{dbdefault};
 418   &dbconnect_vars($form, $form->{dbdefault});
 419   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
 420     or $form->dberror;
 421   my $query = $dbdelete{$form->{dbdriver}};
 422   do_query($form, $dbh, $query);
 423
 424   $dbh->disconnect;
 425
 426   $main::lxdebug->leave_sub();
 427 }
 428
 429 sub dbsources_unused {
 430   $main::lxdebug->enter_sub();
 431
 432   my ($self, $form) = @_;
 433
 434   $form->{only_acc_db} = 1;
 435
 436   my %members = $main::auth->read_all_users();
 437   my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
 438
 439   $dbexcl{$form->{dbdefault}}             = 1;
 440   $dbexcl{$main::auth->{DB_config}->{db}} = 1;
 441
 442   my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
 443
 444   $main::lxdebug->leave_sub();
 445
 446   return @dbunused;
 447 }
 448
 449 sub dbneedsupdate {
 450   $main::lxdebug->enter_sub();
 451
 452   my ($self, $form) = @_;
 453
 454   my %members   = $main::auth->read_all_users();
 455   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
 456
 457   my ($query, $sth, %dbs_needing_updates);
 458
 459   foreach my $login (grep /[a-z]/, keys %members) {
 460     my $member = $members{$login};
 461
 462     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
 463     dbconnect_vars($form, $form->{dbname});
 464
 465     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options);
 466
 467     next unless $dbh;
 468
 469     my $version;
 470
 471     $query = qq|SELECT version FROM defaults|;
 472     $sth = prepare_query($form, $dbh, $query);
 473     if ($sth->execute()) {
 474       ($version) = $sth->fetchrow_array();
 475     }
 476     $sth->finish();
 477
 478     $dbh->disconnect and next unless $version;
 479
 480     my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
 481     $dbh->disconnect;
 482
 483    if ($update_available) {
 484       my $dbinfo = {};
 485       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
 486       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
 487     }
 488   }
 489
 490   $main::lxdebug->leave_sub();
 491
 492   return values %dbs_needing_updates;
 493 }
 494
 495 sub calc_version {
 496   $main::lxdebug->enter_sub(2);
 497
 498   my (@v, $version, $i);
 499
 500   @v = split(/\./, $_[0]);
 501   while (scalar(@v) < 4) {
 502     push(@v, 0);
 503   }
 504   $version = 0;
 505   for ($i = 0; $i < 4; $i++) {
 506     $version *= 1000;
 507     $version += $v[$i];
 508   }
 509
 510   $main::lxdebug->leave_sub(2);
 511   return $version;
 512 }
 513
 514 sub cmp_script_version {
 515   my ($a_from, $a_to, $b_from, $b_to);
 516   my ($i, $res_a, $res_b);
 517   my ($my_a, $my_b) = ($a, $b);
 518
 519   $my_a =~ s/.*-upgrade-//;
 520   $my_a =~ s/.sql$//;
 521   $my_b =~ s/.*-upgrade-//;
 522   $my_b =~ s/.sql$//;
 523   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
 524   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
 525
 526   $res_a = calc_version($my_a_from);
 527   $res_b = calc_version($my_b_from);
 528
 529   if ($res_a == $res_b) {
 530     $res_a = calc_version($my_a_to);
 531     $res_b = calc_version($my_b_to);
 532   }
 533
 534   return $res_a <=> $res_b;
 535 }
 536
 537 sub create_schema_info_table {
 538   $main::lxdebug->enter_sub();
 539
 540   my ($self, $form, $dbh) = @_;
 541
 542   my $query = "SELECT tag FROM schema_info LIMIT 1";
 543   if (!$dbh->do($query)) {
 544     $dbh->rollback();
 545     $query =
 546       qq|CREATE TABLE schema_info (| .
 547       qq|  tag text, | .
 548       qq|  login text, | .
 549       qq|  itime timestamp DEFAULT now(), | .
 550       qq|  PRIMARY KEY (tag))|;
 551     $dbh->do($query) || $form->dberror($query);
 552   }
 553
 554   $main::lxdebug->leave_sub();
 555 }
 556
 557 sub dbupdate {
 558   $main::lxdebug->enter_sub();
 559
 560   my ($self, $form) = @_;
 561
 562   local *SQLDIR;
 563
 564   $form->{sid} = $form->{dbdefault};
 565
 566   my @upgradescripts = ();
 567   my $query;
 568   my $rc = -2;
 569
 570   if ($form->{dbupdate}) {
 571
 572     # read update scripts into memory
 573     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
 574       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 575     @upgradescripts =
 576       sort(cmp_script_version
 577            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
 578                 readdir(SQLDIR)));
 579     closedir(SQLDIR);
 580   }
 581
 582   my $db_charset = $::lx_office_conf{system}->{dbcharset};
 583   $db_charset ||= Common::DEFAULT_CHARSET;
 584
 585   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
 586
 587   foreach my $db (split(/ /, $form->{dbupdate})) {
 588
 589     next unless $form->{$db};
 590
 591     # strip db from dataset
 592     $db =~ s/^db//;
 593     &dbconnect_vars($form, $db);
 594
 595     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
 596       or $form->dberror;
 597
 598     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 599
 600     # check version
 601     $query = qq|SELECT version FROM defaults|;
 602     my ($version) = selectrow_query($form, $dbh, $query);
 603
 604     next unless $version;
 605
 606     $version = calc_version($version);
 607
 608     foreach my $upgradescript (@upgradescripts) {
 609       my $a = $upgradescript;
 610       $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
 611
 612       my ($mindb, $maxdb) = split /-/, $a;
 613       my $str_maxdb = $maxdb;
 614       $mindb = calc_version($mindb);
 615       $maxdb = calc_version($maxdb);
 616
 617       next if ($version >= $maxdb);
 618
 619       # if there is no upgrade script exit
 620       last if ($version < $mindb);
 621
 622       # apply upgrade
 623       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
 624       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 625
 626       $version = $maxdb;
 627
 628     }
 629
 630     $rc = 0;
 631     $dbh->disconnect;
 632
 633   }
 634
 635   $main::lxdebug->leave_sub();
 636
 637   return $rc;
 638 }
 639
 640 sub dbupdate2 {
 641   $main::lxdebug->enter_sub();
 642
 643   my ($self, $form, $dbupdater) = @_;
 644
 645   $form->{sid} = $form->{dbdefault};
 646
 647   my $rc         = -2;
 648   my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
 649
 650   map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
 651
 652   foreach my $db (split / /, $form->{dbupdate}) {
 653     next unless $form->{$db};
 654
 655     # strip db from dataset
 656     $db =~ s/^db//;
 657     &dbconnect_vars($form, $db);
 658
 659     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror;
 660
 661     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 662
 663     $self->create_schema_info_table($form, $dbh);
 664
 665     my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
 666
 667     $dbh->disconnect and next if !@upgradescripts;
 668
 669     foreach my $control (@upgradescripts) {
 670       # apply upgrade
 671       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
 672       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 673
 674       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
 675     }
 676
 677     $rc = 0;
 678     $dbh->disconnect;
 679
 680   }
 681
 682   $main::lxdebug->leave_sub();
 683
 684   return $rc;
 685 }
 686
 687 sub save_member {
 688   $main::lxdebug->enter_sub();
 689
 690   my ($self) = @_;
 691
 692   # format dbconnect and dboptions string
 693   dbconnect_vars($self, $self->{dbname});
 694
 695   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 696
 697   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 698
 699   my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd}, SL::DBConnect->get_options);
 700   if ($dbh) {
 701     $self->create_employee_entry($::form, $dbh, $self, 1);
 702     $dbh->disconnect();
 703   }
 704
 705   $main::lxdebug->leave_sub();
 706 }
 707
 708 sub create_employee_entry {
 709   $main::lxdebug->enter_sub();
 710
 711   my $self            = shift;
 712   my $form            = shift;
 713   my $dbh             = shift;
 714   my $myconfig        = shift;
 715   my $update_existing = shift;
 716
 717   if (!does_table_exist($dbh, 'employee')) {
 718     $main::lxdebug->leave_sub();
 719     return;
 720   }
 721
 722   # add login to employee table if it does not exist
 723   # no error check for employee table, ignore if it does not exist
 724   my ($id)         = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 725   my ($good_db)    = selectrow_query($form, $dbh, qq|select * from pg_tables where tablename = ? and schemaname = ?|, 'schema_info', 'public');
 726   my  $can_delete;
 727      ($can_delete) = selectrow_query($form, $dbh, qq|SELECT tag FROM schema_info WHERE tag = ?|, 'employee_deleted') if $good_db;
 728
 729   if (!$id) {
 730     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 731     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 732
 733   } elsif ($update_existing && $can_delete) {
 734     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user', deleted = 'f' WHERE id = ?|;
 735     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 736   }
 737
 738   $main::lxdebug->leave_sub();
 739 }
 740
 741 sub config_vars {
 742   $main::lxdebug->enter_sub();
 743
 744   my @conf = qw(address admin businessnumber company countrycode
 745     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 746     dbname dbuser dbpasswd email fax name numberformat password
 747     printer sid signature stylesheet tel templates vclimit angebote
 748     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 749     taxnumber co_ustid duns menustyle template_format default_media
 750     default_printer_id copies show_form_details favorites
 751     pdonumber sdonumber hide_cvar_search_options mandatory_departments
 752     sepa_creditor_id taxincluded_checked);
 753
 754   $main::lxdebug->leave_sub();
 755
 756   return @conf;
 757 }
 758
 759 sub error {
 760   $main::lxdebug->enter_sub();
 761
 762   my ($self, $msg) = @_;
 763
 764   $main::lxdebug->show_backtrace();
 765
 766   if ($ENV{HTTP_USER_AGENT}) {
 767     print qq|Content-Type: text/html
 768
 769 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
 770
 771 <body bgcolor=ffffff>
 772
 773 <h2><font color=red>Error!</font></h2>
 774 <p><b>$msg</b>|;
 775
 776   }
 777
 778   die "Error: $msg\n";
 779
 780   $main::lxdebug->leave_sub();
 781 }
 782
 783 sub data {
 784   +{ %{ $_[0] } }
 785 }
 786
 787 1;