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