SL/User.pm

   1 #=====================================================================
   2 # LX-Office ERP
   3 # Copyright (C) 2004
   4 # Based on SQL-Ledger Version 2.1.9
   5 # Web http://www.lx-office.org
   6 #
   7 #=====================================================================
   8 # SQL-Ledger Accounting
   9 # Copyright (C) 2001
  10 #
  11 #  Author: Dieter Simader
  12 #   Email: dsimader@sql-ledger.org
  13 #     Web: http://www.sql-ledger.org
  14 #
  15 #  Contributors:
  16 #
  17 # This program is free software; you can redistribute it and/or modify
  18 # it under the terms of the GNU General Public License as published by
  19 # the Free Software Foundation; either version 2 of the License, or
  20 # (at your option) any later version.
  21 #
  22 # This program is distributed in the hope that it will be useful,
  23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25 # GNU General Public License for more details.
  26 # You should have received a copy of the GNU General Public License
  27 # along with this program; if not, write to the Free Software
  28 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29 #=====================================================================
  30 #
  31 # user related functions
  32 #
  33 #=====================================================================
  34
  35 package User;
  36
  37 use IO::File;
  38 use Fcntl qw(:seek);
  39
  40 #use SL::Auth;
  41 use SL::DBConnect;
  42 use SL::DBUpgrade2;
  43 use SL::DBUtils;
  44 use SL::Iconv;
  45 use SL::Inifile;
  46
  47 use strict;
  48
  49 sub new {
  50   $main::lxdebug->enter_sub();
  51
  52   my ($type, %params) = @_;
  53
  54   my $self = {};
  55
  56   if ($params{id} || $params{login}) {
  57     my %user_data = $main::auth->read_user(%params);
  58     map { $self->{$_} = $user_data{$_} } keys %user_data;
  59   }
  60
  61   $main::lxdebug->leave_sub();
  62
  63   bless $self, $type;
  64 }
  65
  66 sub country_codes {
  67   $main::lxdebug->enter_sub();
  68
  69   local *DIR;
  70
  71   my %cc       = ();
  72   my @language = ();
  73
  74   # scan the locale directory and read in the LANGUAGE files
  75   opendir(DIR, "locale");
  76
  77   my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
  78
  79   foreach my $dir (@dir) {
  80     next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE");
  81     @language = <$fh>;
  82     close $fh;
  83
  84     $cc{$dir} = "@language";
  85   }
  86
  87   closedir(DIR);
  88
  89   $main::lxdebug->leave_sub();
  90
  91   return %cc;
  92 }
  93
  94 sub login {
  95   $main::lxdebug->enter_sub();
  96
  97   my ($self, $form) = @_;
  98   our $sid;
  99
 100   local *FH;
 101
 102   my $rc = -3;
 103
 104   if ($self->{login}) {
 105     my %myconfig = $main::auth->read_user(login => $self->{login});
 106
 107     # check if database is down
 108     my $dbh = SL::DBConnect->connect($myconfig{dbconnect}, $myconfig{dbuser}, $myconfig{dbpasswd})
 109       or $self->error($DBI::errstr);
 110
 111     # we got a connection, check the version
 112     my $query = qq|SELECT version FROM defaults|;
 113     my $sth   = $dbh->prepare($query);
 114     $sth->execute || $form->dberror($query);
 115
 116     my ($dbversion) = $sth->fetchrow_array;
 117     $sth->finish;
 118
 119     $self->create_employee_entry($form, $dbh, \%myconfig);
 120
 121     $self->create_schema_info_table($form, $dbh);
 122
 123     my $dbupdater_auth = SL::DBUpgrade2->new(form => $form, dbdriver => 'Pg', auth => 1)->parse_dbupdate_controls;
 124     if ($dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect)) {
 125       $::lxdebug->leave_sub;
 126       return -3;
 127     }
 128
 129     $rc = 0;
 130
 131     my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $myconfig{dbdriver})->parse_dbupdate_controls;
 132
 133     map({ $form->{$_} = $myconfig{$_} } qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
 134     dbconnect_vars($form, $form->{dbname});
 135     my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh);
 136     $dbh->disconnect;
 137
 138     if ($update_available) {
 139       $form->{"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                   'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
 203                   'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
 204         },
 205         'Oracle' => {
 206           'yy-mm-dd'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
 207           'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
 208           'mm/dd/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
 209           'dd/mm/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'',
 210           'dd.mm.yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'',
 211         });
 212
 213   $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
 214
 215   if ($form->{dbdriver} eq 'Pg') {
 216     $form->{dbconnect} = "dbi:Pg:dbname=$db";
 217   }
 218
 219   if ($form->{dbdriver} eq 'Oracle') {
 220     $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
 221   }
 222
 223   if ($form->{dbhost}) {
 224     $form->{dbconnect} .= ";host=$form->{dbhost}";
 225   }
 226   if ($form->{dbport}) {
 227     $form->{dbconnect} .= ";port=$form->{dbport}";
 228   }
 229
 230   $main::lxdebug->leave_sub();
 231 }
 232
 233 sub dbdrivers {
 234   $main::lxdebug->enter_sub();
 235
 236   my @drivers = DBI->available_drivers();
 237
 238   $main::lxdebug->leave_sub();
 239
 240   return (grep { /(Pg|Oracle)/ } @drivers);
 241 }
 242
 243 sub dbsources {
 244   $main::lxdebug->enter_sub();
 245
 246   my ($self, $form) = @_;
 247
 248   my @dbsources = ();
 249   my ($sth, $query);
 250
 251   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
 252   $form->{sid} = $form->{dbdefault};
 253   &dbconnect_vars($form, $form->{dbdefault});
 254
 255   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 256     or $form->dberror;
 257
 258   if ($form->{dbdriver} eq 'Pg') {
 259     $query =
 260       qq|SELECT datname FROM pg_database | .
 261       qq|WHERE NOT datname IN ('template0', 'template1')|;
 262     $sth = $dbh->prepare($query);
 263     $sth->execute() || $form->dberror($query);
 264
 265     while (my ($db) = $sth->fetchrow_array) {
 266
 267       if ($form->{only_acc_db}) {
 268
 269         next if ($db =~ /^template/);
 270
 271         &dbconnect_vars($form, $db);
 272         my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 273           or $form->dberror;
 274
 275         $query =
 276           qq|SELECT tablename FROM pg_tables | .
 277           qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
 278         my $sth = $dbh->prepare($query);
 279         $sth->execute($form->{dbuser}) ||
 280           $form->dberror($query . " ($form->{dbuser})");
 281
 282         if ($sth->fetchrow_array) {
 283           push(@dbsources, $db);
 284         }
 285         $sth->finish;
 286         $dbh->disconnect;
 287         next;
 288       }
 289       push(@dbsources, $db);
 290     }
 291   }
 292
 293   if ($form->{dbdriver} eq 'Oracle') {
 294     if ($form->{only_acc_db}) {
 295       $query =
 296         qq|SELECT owner FROM dba_objects | .
 297         qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
 298     } else {
 299       $query = qq|SELECT username FROM dba_users|;
 300     }
 301
 302     $sth = $dbh->prepare($query);
 303     $sth->execute || $form->dberror($query);
 304
 305     while (my ($db) = $sth->fetchrow_array) {
 306       push(@dbsources, $db);
 307     }
 308   }
 309
 310   $sth->finish;
 311   $dbh->disconnect;
 312
 313   $main::lxdebug->leave_sub();
 314
 315   return @dbsources;
 316 }
 317
 318 sub dbclusterencoding {
 319   $main::lxdebug->enter_sub();
 320
 321   my ($self, $form) = @_;
 322
 323   $form->{dbdefault} ||= $form->{dbuser};
 324
 325   dbconnect_vars($form, $form->{dbdefault});
 326
 327   my $dbh                = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
 328   my $query              = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
 329   my ($cluster_encoding) = $dbh->selectrow_array($query);
 330   $dbh->disconnect();
 331
 332   $main::lxdebug->leave_sub();
 333
 334   return $cluster_encoding;
 335 }
 336
 337 sub dbcreate {
 338   $main::lxdebug->enter_sub();
 339
 340   my ($self, $form) = @_;
 341
 342   $form->{sid} = $form->{dbdefault};
 343   &dbconnect_vars($form, $form->{dbdefault});
 344   my $dbh =
 345     SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 346     or $form->dberror;
 347   $form->{db} =~ s/\"//g;
 348   my %dbcreate = (
 349     'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
 350     'Oracle' =>
 351     qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
 352     qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
 353   );
 354
 355   my %dboptions = (
 356     'Pg' => [],
 357   );
 358
 359   push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
 360     if ($form->{"encoding"});
 361   if ($form->{"dbdefault"}) {
 362     my $dbdefault = $form->{"dbdefault"};
 363     $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
 364     push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
 365   }
 366
 367   my $query = $dbcreate{$form->{dbdriver}};
 368   $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
 369
 370   # Ignore errors if the database exists.
 371   $dbh->do($query);
 372
 373   if ($form->{dbdriver} eq 'Oracle') {
 374     $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
 375     do_query($form, $dbh, $query);
 376   }
 377   $dbh->disconnect;
 378
 379   # setup variables for the new database
 380   if ($form->{dbdriver} eq 'Oracle') {
 381     $form->{dbuser}   = $form->{db};
 382     $form->{dbpasswd} = $form->{db};
 383   }
 384
 385   &dbconnect_vars($form, $form->{db});
 386
 387   $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 388     or $form->dberror;
 389
 390   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
 391   $db_charset ||= Common::DEFAULT_CHARSET;
 392
 393   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
 394   # create the tables
 395   $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
 396
 397   # load chart of accounts
 398   $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
 399
 400   $query = "UPDATE defaults SET coa = ?";
 401   do_query($form, $dbh, $query, $form->{chart});
 402   $query = "UPDATE defaults SET accounting_method = ?";
 403   do_query($form, $dbh, $query, $form->{accounting_method});
 404   $query = "UPDATE defaults SET profit_determination = ?";
 405   do_query($form, $dbh, $query, $form->{profit_determination});
 406   $query = "UPDATE defaults SET inventory_system = ?";
 407   do_query($form, $dbh, $query, $form->{inventory_system});
 408
 409   $dbh->disconnect;
 410
 411   $main::lxdebug->leave_sub();
 412 }
 413
 414 sub dbdelete {
 415   $main::lxdebug->enter_sub();
 416
 417   my ($self, $form) = @_;
 418   $form->{db} =~ s/\"//g;
 419   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 420                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
 421
 422   $form->{sid} = $form->{dbdefault};
 423   &dbconnect_vars($form, $form->{dbdefault});
 424   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 425     or $form->dberror;
 426   my $query = $dbdelete{$form->{dbdriver}};
 427   do_query($form, $dbh, $query);
 428
 429   $dbh->disconnect;
 430
 431   $main::lxdebug->leave_sub();
 432 }
 433
 434 sub dbsources_unused {
 435   $main::lxdebug->enter_sub();
 436
 437   my ($self, $form) = @_;
 438
 439   $form->{only_acc_db} = 1;
 440
 441   my %members = $main::auth->read_all_users();
 442   my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
 443
 444   $dbexcl{$form->{dbdefault}}             = 1;
 445   $dbexcl{$main::auth->{DB_config}->{db}} = 1;
 446
 447   my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
 448
 449   $main::lxdebug->leave_sub();
 450
 451   return @dbunused;
 452 }
 453
 454 sub dbneedsupdate {
 455   $main::lxdebug->enter_sub();
 456
 457   my ($self, $form) = @_;
 458
 459   my %members   = $main::auth->read_all_users();
 460   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
 461
 462   my ($query, $sth, %dbs_needing_updates);
 463
 464   foreach my $login (grep /[a-z]/, keys %members) {
 465     my $member = $members{$login};
 466
 467     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
 468     dbconnect_vars($form, $form->{dbname});
 469
 470     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
 471
 472     next unless $dbh;
 473
 474     my $version;
 475
 476     $query = qq|SELECT version FROM defaults|;
 477     $sth = prepare_query($form, $dbh, $query);
 478     if ($sth->execute()) {
 479       ($version) = $sth->fetchrow_array();
 480     }
 481     $sth->finish();
 482
 483     $dbh->disconnect and next unless $version;
 484
 485     my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
 486     $dbh->disconnect;
 487
 488    if ($update_available) {
 489       my $dbinfo = {};
 490       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
 491       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
 492     }
 493   }
 494
 495   $main::lxdebug->leave_sub();
 496
 497   return values %dbs_needing_updates;
 498 }
 499
 500 sub calc_version {
 501   $main::lxdebug->enter_sub(2);
 502
 503   my (@v, $version, $i);
 504
 505   @v = split(/\./, $_[0]);
 506   while (scalar(@v) < 4) {
 507     push(@v, 0);
 508   }
 509   $version = 0;
 510   for ($i = 0; $i < 4; $i++) {
 511     $version *= 1000;
 512     $version += $v[$i];
 513   }
 514
 515   $main::lxdebug->leave_sub(2);
 516   return $version;
 517 }
 518
 519 sub cmp_script_version {
 520   my ($a_from, $a_to, $b_from, $b_to);
 521   my ($i, $res_a, $res_b);
 522   my ($my_a, $my_b) = ($a, $b);
 523
 524   $my_a =~ s/.*-upgrade-//;
 525   $my_a =~ s/.sql$//;
 526   $my_b =~ s/.*-upgrade-//;
 527   $my_b =~ s/.sql$//;
 528   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
 529   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
 530
 531   $res_a = calc_version($my_a_from);
 532   $res_b = calc_version($my_b_from);
 533
 534   if ($res_a == $res_b) {
 535     $res_a = calc_version($my_a_to);
 536     $res_b = calc_version($my_b_to);
 537   }
 538
 539   return $res_a <=> $res_b;
 540 }
 541
 542 sub create_schema_info_table {
 543   $main::lxdebug->enter_sub();
 544
 545   my ($self, $form, $dbh) = @_;
 546
 547   my $query = "SELECT tag FROM schema_info LIMIT 1";
 548   if (!$dbh->do($query)) {
 549     $dbh->rollback();
 550     $query =
 551       qq|CREATE TABLE schema_info (| .
 552       qq|  tag text, | .
 553       qq|  login text, | .
 554       qq|  itime timestamp DEFAULT now(), | .
 555       qq|  PRIMARY KEY (tag))|;
 556     $dbh->do($query) || $form->dberror($query);
 557   }
 558
 559   $main::lxdebug->leave_sub();
 560 }
 561
 562 sub dbupdate {
 563   $main::lxdebug->enter_sub();
 564
 565   my ($self, $form) = @_;
 566
 567   local *SQLDIR;
 568
 569   $form->{sid} = $form->{dbdefault};
 570
 571   my @upgradescripts = ();
 572   my $query;
 573   my $rc = -2;
 574
 575   if ($form->{dbupdate}) {
 576
 577     # read update scripts into memory
 578     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
 579       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 580     @upgradescripts =
 581       sort(cmp_script_version
 582            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
 583                 readdir(SQLDIR)));
 584     closedir(SQLDIR);
 585   }
 586
 587   my $db_charset = $::lx_office_conf{system}->{dbcharset};
 588   $db_charset ||= Common::DEFAULT_CHARSET;
 589
 590   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
 591
 592   foreach my $db (split(/ /, $form->{dbupdate})) {
 593
 594     next unless $form->{$db};
 595
 596     # strip db from dataset
 597     $db =~ s/^db//;
 598     &dbconnect_vars($form, $db);
 599
 600     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 601       or $form->dberror;
 602
 603     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 604
 605     # check version
 606     $query = qq|SELECT version FROM defaults|;
 607     my ($version) = selectrow_query($form, $dbh, $query);
 608
 609     next unless $version;
 610
 611     $version = calc_version($version);
 612
 613     foreach my $upgradescript (@upgradescripts) {
 614       my $a = $upgradescript;
 615       $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
 616
 617       my ($mindb, $maxdb) = split /-/, $a;
 618       my $str_maxdb = $maxdb;
 619       $mindb = calc_version($mindb);
 620       $maxdb = calc_version($maxdb);
 621
 622       next if ($version >= $maxdb);
 623
 624       # if there is no upgrade script exit
 625       last if ($version < $mindb);
 626
 627       # apply upgrade
 628       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
 629       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 630
 631       $version = $maxdb;
 632
 633     }
 634
 635     $rc = 0;
 636     $dbh->disconnect;
 637
 638   }
 639
 640   $main::lxdebug->leave_sub();
 641
 642   return $rc;
 643 }
 644
 645 sub dbupdate2 {
 646   $main::lxdebug->enter_sub();
 647
 648   my ($self, $form, $dbupdater) = @_;
 649
 650   $form->{sid} = $form->{dbdefault};
 651
 652   my $rc         = -2;
 653   my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
 654
 655   map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
 656
 657   foreach my $db (split / /, $form->{dbupdate}) {
 658     next unless $form->{$db};
 659
 660     # strip db from dataset
 661     $db =~ s/^db//;
 662     &dbconnect_vars($form, $db);
 663
 664     my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 665
 666     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 667
 668     $self->create_schema_info_table($form, $dbh);
 669
 670     my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
 671
 672     $dbh->disconnect and next if !@upgradescripts;
 673
 674     foreach my $control (@upgradescripts) {
 675       # apply upgrade
 676       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
 677       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 678
 679       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
 680     }
 681
 682     $rc = 0;
 683     $dbh->disconnect;
 684
 685   }
 686
 687   $main::lxdebug->leave_sub();
 688
 689   return $rc;
 690 }
 691
 692 sub save_member {
 693   $main::lxdebug->enter_sub();
 694
 695   my ($self) = @_;
 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   my ($good_db)    = selectrow_query($form, $dbh, qq|select * from pg_tables where tablename = ? and schemaname = ?|, 'schema_info', 'public');
 731   my  $can_delete;
 732      ($can_delete) = selectrow_query($form, $dbh, qq|SELECT tag FROM schema_info WHERE tag = ?|, 'employee_deleted') if $good_db;
 733
 734   if (!$id) {
 735     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 736     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 737
 738   } elsif ($update_existing && $can_delete) {
 739     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user', deleted = 'f' WHERE id = ?|;
 740     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 741   }
 742
 743   $main::lxdebug->leave_sub();
 744 }
 745
 746 sub config_vars {
 747   $main::lxdebug->enter_sub();
 748
 749   my @conf = qw(address admin businessnumber company countrycode
 750     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 751     dbname dbuser dbpasswd email fax name numberformat password
 752     printer sid signature stylesheet tel templates vclimit angebote
 753     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 754     taxnumber co_ustid duns menustyle template_format default_media
 755     default_printer_id copies show_form_details favorites
 756     pdonumber sdonumber hide_cvar_search_options mandatory_departments
 757     sepa_creditor_id taxincluded_checked);
 758
 759   $main::lxdebug->leave_sub();
 760
 761   return @conf;
 762 }
 763
 764 sub error {
 765   $main::lxdebug->enter_sub();
 766
 767   my ($self, $msg) = @_;
 768
 769   $main::lxdebug->show_backtrace();
 770
 771   if ($ENV{HTTP_USER_AGENT}) {
 772     print qq|Content-Type: text/html
 773
 774 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
 775
 776 <body bgcolor=ffffff>
 777
 778 <h2><font color=red>Error!</font></h2>
 779 <p><b>$msg</b>|;
 780
 781   }
 782
 783   die "Error: $msg\n";
 784
 785   $main::lxdebug->leave_sub();
 786 }
 787
 788 sub data {
 789   +{ %{ $_[0] } }
 790 }
 791
 792 1;
 793