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     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->{"stylesheet"} = "lx-office-erp.css";
 140       $form->{"title"} = $main::locale->text("Dataset upgrade");
 141       $form->header();
 142       print $form->parse_html_template("dbupgrade/header");
 143
 144       $form->{dbupdate} = "db$myconfig{dbname}";
 145       $form->{ $form->{dbupdate} } = 1;
 146
 147       if ($form->{"show_dbupdate_warning"}) {
 148         print $form->parse_html_template("dbupgrade/warning");
 149         ::end_of_request();
 150       }
 151
 152       # update the tables
 153       if (!open(FH, ">" . $::lx_office_conf{paths}->{userspath} . "/nologin")) {
 154         $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
 155                                                       'Please verify that the directory "#1" is writeable by the webserver.',
 156                                                       $::lx_office_conf{paths}->{userspath}),
 157                                   'back_button' => 1);
 158       }
 159
 160       # required for Oracle
 161       $form->{dbdefault} = $sid;
 162
 163       # ignore HUP, QUIT in case the webserver times out
 164       $SIG{HUP}  = 'IGNORE';
 165       $SIG{QUIT} = 'IGNORE';
 166
 167       $self->dbupdate($form);
 168       $self->dbupdate2($form, $dbupdater);
 169       SL::DBUpgrade2->new(form => $::form, dbdriver => 'Pg', auth => 1)->apply_admin_dbupgrade_scripts(0);
 170
 171       close(FH);
 172
 173       # remove lock file
 174       unlink($::lx_office_conf{paths}->{userspath} . "/nologin");
 175
 176       my $menufile =
 177         $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
 178         $self->{"menustyle"} eq "neu" ? "menunew.pl" :
 179         $self->{"menustyle"} eq "js" ? "menujs.pl" :
 180         $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
 181         "menu.pl";
 182
 183       print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
 184
 185       $rc = -2;
 186     }
 187   }
 188
 189   $main::lxdebug->leave_sub();
 190
 191   return $rc;
 192 }
 193
 194 sub dbconnect_vars {
 195   $main::lxdebug->enter_sub();
 196
 197   my ($form, $db) = @_;
 198
 199   my %dboptions = (
 200         'Pg' => { 'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
 201                   'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
 202                   'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
 203                   'mm-dd-yy'   => 'set DateStyle to \'POSTGRES, US\'',
 204                   'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
 205                   'dd-mm-yy'   => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
 206                   'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
 207         },
 208         'Oracle' => {
 209           'yy-mm-dd'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
 210           'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
 211           'mm/dd/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
 212           'mm-dd-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
 213           'dd/mm/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
 214           'dd-mm-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'',
 215           'dd.mm.yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
 216         });
 217
 218   $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
 219
 220   if ($form->{dbdriver} eq 'Pg') {
 221     $form->{dbconnect} = "dbi:Pg:dbname=$db";
 222   }
 223
 224   if ($form->{dbdriver} eq 'Oracle') {
 225     $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
 226   }
 227
 228   if ($form->{dbhost}) {
 229     $form->{dbconnect} .= ";host=$form->{dbhost}";
 230   }
 231   if ($form->{dbport}) {
 232     $form->{dbconnect} .= ";port=$form->{dbport}";
 233   }
 234
 235   $main::lxdebug->leave_sub();
 236 }
 237
 238 sub dbdrivers {
 239   $main::lxdebug->enter_sub();
 240
 241   my @drivers = DBI->available_drivers();
 242
 243   $main::lxdebug->leave_sub();
 244
 245   return (grep { /(Pg|Oracle)/ } @drivers);
 246 }
 247
 248 sub dbsources {
 249   $main::lxdebug->enter_sub();
 250
 251   my ($self, $form) = @_;
 252
 253   my @dbsources = ();
 254   my ($sth, $query);
 255
 256   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
 257   $form->{sid} = $form->{dbdefault};
 258   &dbconnect_vars($form, $form->{dbdefault});
 259
 260   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 261     or $form->dberror;
 262
 263   if ($form->{dbdriver} eq 'Pg') {
 264     $query =
 265       qq|SELECT datname FROM pg_database | .
 266       qq|WHERE NOT datname IN ('template0', 'template1')|;
 267     $sth = $dbh->prepare($query);
 268     $sth->execute() || $form->dberror($query);
 269
 270     while (my ($db) = $sth->fetchrow_array) {
 271
 272       if ($form->{only_acc_db}) {
 273
 274         next if ($db =~ /^template/);
 275
 276         &dbconnect_vars($form, $db);
 277         my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 278           or $form->dberror;
 279
 280         $query =
 281           qq|SELECT tablename FROM pg_tables | .
 282           qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
 283         my $sth = $dbh->prepare($query);
 284         $sth->execute($form->{dbuser}) ||
 285           $form->dberror($query . " ($form->{dbuser})");
 286
 287         if ($sth->fetchrow_array) {
 288           push(@dbsources, $db);
 289         }
 290         $sth->finish;
 291         $dbh->disconnect;
 292         next;
 293       }
 294       push(@dbsources, $db);
 295     }
 296   }
 297
 298   if ($form->{dbdriver} eq 'Oracle') {
 299     if ($form->{only_acc_db}) {
 300       $query =
 301         qq|SELECT owner FROM dba_objects | .
 302         qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
 303     } else {
 304       $query = qq|SELECT username FROM dba_users|;
 305     }
 306
 307     $sth = $dbh->prepare($query);
 308     $sth->execute || $form->dberror($query);
 309
 310     while (my ($db) = $sth->fetchrow_array) {
 311       push(@dbsources, $db);
 312     }
 313   }
 314
 315   $sth->finish;
 316   $dbh->disconnect;
 317
 318   $main::lxdebug->leave_sub();
 319
 320   return @dbsources;
 321 }
 322
 323 sub dbclusterencoding {
 324   $main::lxdebug->enter_sub();
 325
 326   my ($self, $form) = @_;
 327
 328   $form->{dbdefault} ||= $form->{dbuser};
 329
 330   dbconnect_vars($form, $form->{dbdefault});
 331
 332   my $dbh                = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
 333   my $query              = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
 334   my ($cluster_encoding) = $dbh->selectrow_array($query);
 335   $dbh->disconnect();
 336
 337   $main::lxdebug->leave_sub();
 338
 339   return $cluster_encoding;
 340 }
 341
 342 sub dbcreate {
 343   $main::lxdebug->enter_sub();
 344
 345   my ($self, $form) = @_;
 346
 347   $form->{sid} = $form->{dbdefault};
 348   &dbconnect_vars($form, $form->{dbdefault});
 349   my $dbh =
 350     SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 351     or $form->dberror;
 352   $form->{db} =~ s/\"//g;
 353   my %dbcreate = (
 354     'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
 355     'Oracle' =>
 356     qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
 357     qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
 358   );
 359
 360   my %dboptions = (
 361     'Pg' => [],
 362   );
 363
 364   push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
 365     if ($form->{"encoding"});
 366   if ($form->{"dbdefault"}) {
 367     my $dbdefault = $form->{"dbdefault"};
 368     $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
 369     push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
 370   }
 371
 372   my $query = $dbcreate{$form->{dbdriver}};
 373   $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
 374
 375   # Ignore errors if the database exists.
 376   $dbh->do($query);
 377
 378   if ($form->{dbdriver} eq 'Oracle') {
 379     $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
 380     do_query($form, $dbh, $query);
 381   }
 382   $dbh->disconnect;
 383
 384   # setup variables for the new database
 385   if ($form->{dbdriver} eq 'Oracle') {
 386     $form->{dbuser}   = $form->{db};
 387     $form->{dbpasswd} = $form->{db};
 388   }
 389
 390   &dbconnect_vars($form, $form->{db});
 391
 392   $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 393     or $form->dberror;
 394
 395   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
 396   $db_charset ||= Common::DEFAULT_CHARSET;
 397
 398   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
 399   # create the tables
 400   $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
 401
 402   # load chart of accounts
 403   $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
 404
 405   $query = "UPDATE defaults SET coa = ?";
 406   do_query($form, $dbh, $query, $form->{chart});
 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   my $form   = \%main::form;
 696
 697   # format dbconnect and dboptions string
 698   dbconnect_vars($self, $self->{dbname});
 699
 700   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 701
 702   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 703
 704   my $dbh = SL::DBConnect->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
 705   if ($dbh) {
 706     $self->create_employee_entry($form, $dbh, $self, 1);
 707     $dbh->disconnect();
 708   }
 709
 710   $main::lxdebug->leave_sub();
 711 }
 712
 713 sub create_employee_entry {
 714   $main::lxdebug->enter_sub();
 715
 716   my $self            = shift;
 717   my $form            = shift;
 718   my $dbh             = shift;
 719   my $myconfig        = shift;
 720   my $update_existing = shift;
 721
 722   if (!does_table_exist($dbh, 'employee')) {
 723     $main::lxdebug->leave_sub();
 724     return;
 725   }
 726
 727   # add login to employee table if it does not exist
 728   # no error check for employee table, ignore if it does not exist
 729   my ($id)  = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 730
 731   if (!$id) {
 732     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 733     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 734
 735   } elsif ($update_existing) {
 736     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
 737     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 738   }
 739
 740   $main::lxdebug->leave_sub();
 741 }
 742
 743 sub config_vars {
 744   $main::lxdebug->enter_sub();
 745
 746   my @conf = qw(address admin businessnumber company countrycode
 747     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 748     dbname dbuser dbpasswd email fax name numberformat password
 749     printer role sid signature stylesheet tel templates vclimit angebote
 750     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 751     taxnumber co_ustid duns menustyle template_format default_media
 752     default_printer_id copies show_form_details favorites
 753     pdonumber sdonumber hide_cvar_search_options mandatory_departments
 754     sepa_creditor_id);
 755
 756   $main::lxdebug->leave_sub();
 757
 758   return @conf;
 759 }
 760
 761 sub error {
 762   $main::lxdebug->enter_sub();
 763
 764   my ($self, $msg) = @_;
 765
 766   $main::lxdebug->show_backtrace();
 767
 768   if ($ENV{HTTP_USER_AGENT}) {
 769     print qq|Content-Type: text/html
 770
 771 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
 772
 773 <body bgcolor=ffffff>
 774
 775 <h2><font color=red>Error!</font></h2>
 776 <p><b>$msg</b>|;
 777
 778   }
 779
 780   die "Error: $msg\n";
 781
 782   $main::lxdebug->leave_sub();
 783 }
 784
 785 1;
 786