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