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::DBUpgrade2;
  42 use SL::DBUtils;
  43 use SL::Iconv;
  44 use SL::Inifile;
  45
  46 use strict;
  47
  48 sub new {
  49   $main::lxdebug->enter_sub();
  50
  51   my ($type, $login) = @_;
  52
  53   my $self = {};
  54
  55   if ($login ne "") {
  56     my %user_data = $main::auth->read_user($login);
  57     map { $self->{$_} = $user_data{$_} } keys %user_data;
  58   }
  59
  60   $main::lxdebug->leave_sub();
  61
  62   bless $self, $type;
  63 }
  64
  65 sub country_codes {
  66   $main::lxdebug->enter_sub();
  67
  68   local *DIR;
  69
  70   my %cc       = ();
  71   my @language = ();
  72
  73   # scan the locale directory and read in the LANGUAGE files
  74   opendir(DIR, "locale");
  75
  76   my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
  77
  78   foreach my $dir (@dir) {
  79     next unless open(FH, "locale/$dir/LANGUAGE");
  80     @language = <FH>;
  81     close FH;
  82
  83     $cc{$dir} = "@language";
  84   }
  85
  86   closedir(DIR);
  87
  88   $main::lxdebug->leave_sub();
  89
  90   return %cc;
  91 }
  92
  93 sub login {
  94   $main::lxdebug->enter_sub();
  95
  96   my ($self, $form) = @_;
  97   our $sid;
  98
  99   local *FH;
 100
 101   my $rc = -3;
 102
 103   if ($self->{login}) {
 104     my %myconfig = $main::auth->read_user($self->{login});
 105
 106     # check if database is down
 107     my $dbh =
 108       DBI->connect($myconfig{dbconnect}, $myconfig{dbuser},
 109                    $myconfig{dbpasswd})
 110       or $self->error($DBI::errstr);
 111
 112     # we got a connection, check the version
 113     my $query = qq|SELECT version FROM defaults|;
 114     my $sth   = $dbh->prepare($query);
 115     $sth->execute || $form->dberror($query);
 116
 117     my ($dbversion) = $sth->fetchrow_array;
 118     $sth->finish;
 119
 120     $self->create_employee_entry($form, $dbh, \%myconfig);
 121
 122     $self->create_schema_info_table($form, $dbh);
 123
 124     $rc = 0;
 125
 126     my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $myconfig{dbdriver})->parse_dbupdate_controls;
 127
 128     map({ $form->{$_} = $myconfig{$_} } qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
 129     dbconnect_vars($form, $form->{dbname});
 130     my $update_available = $dbupdater->update_available($dbversion) || $dbupdater->update2_available($dbh);
 131     $dbh->disconnect;
 132
 133     if ($update_available) {
 134       $form->{"stylesheet"} = "lx-office-erp.css";
 135       $form->{"title"} = $main::locale->text("Dataset upgrade");
 136       $form->header();
 137       print $form->parse_html_template("dbupgrade/header");
 138
 139       $form->{dbupdate} = "db$myconfig{dbname}";
 140       $form->{ $form->{dbupdate} } = 1;
 141
 142       if ($form->{"show_dbupdate_warning"}) {
 143         print $form->parse_html_template("dbupgrade/warning");
 144         ::end_of_request();
 145       }
 146
 147       # update the tables
 148       if (!open(FH, ">$main::userspath/nologin")) {
 149         $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
 150                                                       'Please verify that the directory "#1" is writeable by the webserver.',
 151                                                       $main::userspath),
 152                                   'back_button' => 1);
 153       }
 154
 155       # required for Oracle
 156       $form->{dbdefault} = $sid;
 157
 158       # ignore HUP, QUIT in case the webserver times out
 159       $SIG{HUP}  = 'IGNORE';
 160       $SIG{QUIT} = 'IGNORE';
 161
 162       $self->dbupdate($form);
 163       $self->dbupdate2($form, $dbupdater);
 164
 165       close(FH);
 166
 167       # remove lock file
 168       unlink("$main::userspath/nologin");
 169
 170       my $menufile =
 171         $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
 172         $self->{"menustyle"} eq "neu" ? "menunew.pl" :
 173         $self->{"menustyle"} eq "js" ? "menujs.pl" :
 174         $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
 175         "menu.pl";
 176
 177       print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
 178
 179       $rc = -2;
 180
 181     }
 182   }
 183
 184   $main::lxdebug->leave_sub();
 185
 186   return $rc;
 187 }
 188
 189 sub dbconnect_vars {
 190   $main::lxdebug->enter_sub();
 191
 192   my ($form, $db) = @_;
 193
 194   my %dboptions = (
 195         'Pg' => { 'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
 196                   'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
 197                   'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
 198                   'mm-dd-yy'   => 'set DateStyle to \'POSTGRES, US\'',
 199                   'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
 200                   'dd-mm-yy'   => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
 201                   'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
 202         },
 203         'Oracle' => {
 204           'yy-mm-dd'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
 205           'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
 206           'mm/dd/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
 207           'mm-dd-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
 208           'dd/mm/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/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 =
 256     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 257     or $form->dberror;
 258
 259   if ($form->{dbdriver} eq 'Pg') {
 260     $query =
 261       qq|SELECT datname FROM pg_database | .
 262       qq|WHERE NOT datname IN ('template0', 'template1')|;
 263     $sth = $dbh->prepare($query);
 264     $sth->execute() || $form->dberror($query);
 265
 266     while (my ($db) = $sth->fetchrow_array) {
 267
 268       if ($form->{only_acc_db}) {
 269
 270         next if ($db =~ /^template/);
 271
 272         &dbconnect_vars($form, $db);
 273         my $dbh =
 274           DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 275           or $form->dberror;
 276
 277         $query =
 278           qq|SELECT tablename FROM pg_tables | .
 279           qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
 280         my $sth = $dbh->prepare($query);
 281         $sth->execute($form->{dbuser}) ||
 282           $form->dberror($query . " ($form->{dbuser})");
 283
 284         if ($sth->fetchrow_array) {
 285           push(@dbsources, $db);
 286         }
 287         $sth->finish;
 288         $dbh->disconnect;
 289         next;
 290       }
 291       push(@dbsources, $db);
 292     }
 293   }
 294
 295   if ($form->{dbdriver} eq 'Oracle') {
 296     if ($form->{only_acc_db}) {
 297       $query =
 298         qq|SELECT owner FROM dba_objects | .
 299         qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
 300     } else {
 301       $query = qq|SELECT username FROM dba_users|;
 302     }
 303
 304     $sth = $dbh->prepare($query);
 305     $sth->execute || $form->dberror($query);
 306
 307     while (my ($db) = $sth->fetchrow_array) {
 308       push(@dbsources, $db);
 309     }
 310   }
 311
 312   $sth->finish;
 313   $dbh->disconnect;
 314
 315   $main::lxdebug->leave_sub();
 316
 317   return @dbsources;
 318 }
 319
 320 sub dbclusterencoding {
 321   $main::lxdebug->enter_sub();
 322
 323   my ($self, $form) = @_;
 324
 325   $form->{dbdefault} ||= $form->{dbuser};
 326
 327   dbconnect_vars($form, $form->{dbdefault});
 328
 329   my $dbh                = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || $form->dberror();
 330   my $query              = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
 331   my ($cluster_encoding) = $dbh->selectrow_array($query);
 332   $dbh->disconnect();
 333
 334   $main::lxdebug->leave_sub();
 335
 336   return $cluster_encoding;
 337 }
 338
 339 sub dbcreate {
 340   $main::lxdebug->enter_sub();
 341
 342   my ($self, $form) = @_;
 343
 344   $form->{sid} = $form->{dbdefault};
 345   &dbconnect_vars($form, $form->{dbdefault});
 346   my $dbh =
 347     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 348     or $form->dberror;
 349   $form->{db} =~ s/\"//g;
 350   my %dbcreate = (
 351     'Pg'     => qq|CREATE DATABASE "$form->{db}"|,
 352     'Oracle' =>
 353     qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
 354     qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
 355   );
 356
 357   my %dboptions = (
 358     'Pg' => [],
 359   );
 360
 361   push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"}))
 362     if ($form->{"encoding"});
 363   if ($form->{"dbdefault"}) {
 364     my $dbdefault = $form->{"dbdefault"};
 365     $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
 366     push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
 367   }
 368
 369   my $query = $dbcreate{$form->{dbdriver}};
 370   $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
 371
 372   # Ignore errors if the database exists.
 373   $dbh->do($query);
 374
 375   if ($form->{dbdriver} eq 'Oracle') {
 376     $query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
 377     do_query($form, $dbh, $query);
 378   }
 379   $dbh->disconnect;
 380
 381   # setup variables for the new database
 382   if ($form->{dbdriver} eq 'Oracle') {
 383     $form->{dbuser}   = $form->{db};
 384     $form->{dbpasswd} = $form->{db};
 385   }
 386
 387   &dbconnect_vars($form, $form->{db});
 388
 389   $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 390     or $form->dberror;
 391
 392   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
 393   $db_charset ||= Common::DEFAULT_CHARSET;
 394
 395   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
 396   # create the tables
 397   $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
 398
 399   # load chart of accounts
 400   $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
 401
 402   $query = "UPDATE defaults SET coa = ?";
 403   do_query($form, $dbh, $query, $form->{chart});
 404
 405   $dbh->disconnect;
 406
 407   $main::lxdebug->leave_sub();
 408 }
 409
 410 sub dbdelete {
 411   $main::lxdebug->enter_sub();
 412
 413   my ($self, $form) = @_;
 414   $form->{db} =~ s/\"//g;
 415   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 416                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
 417
 418   $form->{sid} = $form->{dbdefault};
 419   &dbconnect_vars($form, $form->{dbdefault});
 420   my $dbh =
 421     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 422     or $form->dberror;
 423   my $query = $dbdelete{$form->{dbdriver}};
 424   do_query($form, $dbh, $query);
 425
 426   $dbh->disconnect;
 427
 428   $main::lxdebug->leave_sub();
 429 }
 430
 431 sub dbsources_unused {
 432   $main::lxdebug->enter_sub();
 433
 434   my ($self, $form) = @_;
 435
 436   $form->{only_acc_db} = 1;
 437
 438   my %members = $main::auth->read_all_users();
 439   my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
 440
 441   $dbexcl{$form->{dbdefault}}             = 1;
 442   $dbexcl{$main::auth->{DB_config}->{db}} = 1;
 443
 444   my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
 445
 446   $main::lxdebug->leave_sub();
 447
 448   return @dbunused;
 449 }
 450
 451 sub dbneedsupdate {
 452   $main::lxdebug->enter_sub();
 453
 454   my ($self, $form) = @_;
 455
 456   my %members   = $main::auth->read_all_users();
 457   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls;
 458
 459   my ($query, $sth, %dbs_needing_updates);
 460
 461   foreach my $login (grep /[a-z]/, keys %members) {
 462     my $member = $members{$login};
 463
 464     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
 465     dbconnect_vars($form, $form->{dbname});
 466
 467     my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
 468
 469     next unless $dbh;
 470
 471     my $version;
 472
 473     $query = qq|SELECT version FROM defaults|;
 474     $sth = prepare_query($form, $dbh, $query);
 475     if ($sth->execute()) {
 476       ($version) = $sth->fetchrow_array();
 477     }
 478     $sth->finish();
 479
 480     $dbh->disconnect and next unless $version;
 481
 482     my $update_available = $dbupdater->update_available($version) || $dbupdater->update2_available($dbh);
 483     $dbh->disconnect;
 484
 485    if ($update_available) {
 486       my $dbinfo = {};
 487       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
 488       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
 489     }
 490   }
 491
 492   $main::lxdebug->leave_sub();
 493
 494   return values %dbs_needing_updates;
 495 }
 496
 497 sub calc_version {
 498   $main::lxdebug->enter_sub(2);
 499
 500   my (@v, $version, $i);
 501
 502   @v = split(/\./, $_[0]);
 503   while (scalar(@v) < 4) {
 504     push(@v, 0);
 505   }
 506   $version = 0;
 507   for ($i = 0; $i < 4; $i++) {
 508     $version *= 1000;
 509     $version += $v[$i];
 510   }
 511
 512   $main::lxdebug->leave_sub(2);
 513   return $version;
 514 }
 515
 516 sub cmp_script_version {
 517   my ($a_from, $a_to, $b_from, $b_to);
 518   my ($i, $res_a, $res_b);
 519   my ($my_a, $my_b) = ($a, $b);
 520
 521   $my_a =~ s/.*-upgrade-//;
 522   $my_a =~ s/.sql$//;
 523   $my_b =~ s/.*-upgrade-//;
 524   $my_b =~ s/.sql$//;
 525   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
 526   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
 527
 528   $res_a = calc_version($my_a_from);
 529   $res_b = calc_version($my_b_from);
 530
 531   if ($res_a == $res_b) {
 532     $res_a = calc_version($my_a_to);
 533     $res_b = calc_version($my_b_to);
 534   }
 535
 536   return $res_a <=> $res_b;
 537 }
 538
 539 sub create_schema_info_table {
 540   $main::lxdebug->enter_sub();
 541
 542   my ($self, $form, $dbh) = @_;
 543
 544   my $query = "SELECT tag FROM schema_info LIMIT 1";
 545   if (!$dbh->do($query)) {
 546     $dbh->rollback();
 547     $query =
 548       qq|CREATE TABLE schema_info (| .
 549       qq|  tag text, | .
 550       qq|  login text, | .
 551       qq|  itime timestamp DEFAULT now(), | .
 552       qq|  PRIMARY KEY (tag))|;
 553     $dbh->do($query) || $form->dberror($query);
 554   }
 555
 556   $main::lxdebug->leave_sub();
 557 }
 558
 559 sub dbupdate {
 560   $main::lxdebug->enter_sub();
 561
 562   my ($self, $form) = @_;
 563
 564   local *SQLDIR;
 565
 566   $form->{sid} = $form->{dbdefault};
 567
 568   my @upgradescripts = ();
 569   my $query;
 570   my $rc = -2;
 571
 572   if ($form->{dbupdate}) {
 573
 574     # read update scripts into memory
 575     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
 576       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 577     @upgradescripts =
 578       sort(cmp_script_version
 579            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
 580                 readdir(SQLDIR)));
 581     closedir(SQLDIR);
 582   }
 583
 584   my $db_charset = $main::dbcharset;
 585   $db_charset ||= Common::DEFAULT_CHARSET;
 586
 587   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
 588
 589   foreach my $db (split(/ /, $form->{dbupdate})) {
 590
 591     next unless $form->{$db};
 592
 593     # strip db from dataset
 594     $db =~ s/^db//;
 595     &dbconnect_vars($form, $db);
 596
 597     my $dbh =
 598       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 599       or $form->dberror;
 600
 601     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 602
 603     # check version
 604     $query = qq|SELECT version FROM defaults|;
 605     my ($version) = selectrow_query($form, $dbh, $query);
 606
 607     next unless $version;
 608
 609     $version = calc_version($version);
 610
 611     foreach my $upgradescript (@upgradescripts) {
 612       my $a = $upgradescript;
 613       $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
 614
 615       my ($mindb, $maxdb) = split /-/, $a;
 616       my $str_maxdb = $maxdb;
 617       $mindb = calc_version($mindb);
 618       $maxdb = calc_version($maxdb);
 619
 620       next if ($version >= $maxdb);
 621
 622       # if there is no upgrade script exit
 623       last if ($version < $mindb);
 624
 625       # apply upgrade
 626       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
 627       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 628
 629       $version = $maxdb;
 630
 631     }
 632
 633     $rc = 0;
 634     $dbh->disconnect;
 635
 636   }
 637
 638   $main::lxdebug->leave_sub();
 639
 640   return $rc;
 641 }
 642
 643 sub dbupdate2 {
 644   $main::lxdebug->enter_sub();
 645
 646   my ($self, $form, $dbupdater) = @_;
 647
 648   $form->{sid} = $form->{dbdefault};
 649
 650   my $rc         = -2;
 651   my $db_charset = $main::dbcharset || Common::DEFAULT_CHARSET;
 652
 653   map { $_->{description} = SL::Iconv::convert($_->{charset}, $db_charset, $_->{description}) } values %{ $dbupdater->{all_controls} };
 654
 655   foreach my $db (split / /, $form->{dbupdate}) {
 656     next unless $form->{$db};
 657
 658     # strip db from dataset
 659     $db =~ s/^db//;
 660     &dbconnect_vars($form, $db);
 661
 662     my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror;
 663
 664     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 665
 666     $self->create_schema_info_table($form, $dbh);
 667
 668     my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
 669
 670     $dbh->disconnect and next if !@upgradescripts;
 671
 672     foreach my $control (@upgradescripts) {
 673       # apply upgrade
 674       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
 675       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 676
 677       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
 678     }
 679
 680     $rc = 0;
 681     $dbh->disconnect;
 682
 683   }
 684
 685   $main::lxdebug->leave_sub();
 686
 687   return $rc;
 688 }
 689
 690 sub save_member {
 691   $main::lxdebug->enter_sub();
 692
 693   my ($self) = @_;
 694   my $form   = \%main::form;
 695
 696   # format dbconnect and dboptions string
 697   dbconnect_vars($self, $self->{dbname});
 698
 699   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 700
 701   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 702
 703   my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
 704   if ($dbh) {
 705     $self->create_employee_entry($form, $dbh, $self, 1);
 706     $dbh->disconnect();
 707   }
 708
 709   $main::lxdebug->leave_sub();
 710 }
 711
 712 sub create_employee_entry {
 713   $main::lxdebug->enter_sub();
 714
 715   my $self            = shift;
 716   my $form            = shift;
 717   my $dbh             = shift;
 718   my $myconfig        = shift;
 719   my $update_existing = shift;
 720
 721   if (!does_table_exist($dbh, 'employee')) {
 722     $main::lxdebug->leave_sub();
 723     return;
 724   }
 725
 726   # add login to employee table if it does not exist
 727   # no error check for employee table, ignore if it does not exist
 728   my ($id)  = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 729
 730   if (!$id) {
 731     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 732     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 733
 734   } elsif ($update_existing) {
 735     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
 736     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 737   }
 738
 739   $main::lxdebug->leave_sub();
 740 }
 741
 742 sub config_vars {
 743   $main::lxdebug->enter_sub();
 744
 745   my @conf = qw(address admin businessnumber company countrycode
 746     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 747     dbname dbuser dbpasswd email fax name numberformat password
 748     printer role sid signature stylesheet tel templates vclimit angebote
 749     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 750     taxnumber co_ustid duns menustyle template_format default_media
 751     default_printer_id copies show_form_details favorites
 752     pdonumber sdonumber hide_cvar_search_options mandatory_departments
 753     sepa_creditor_id);
 754
 755   $main::lxdebug->leave_sub();
 756
 757   return @conf;
 758 }
 759
 760 sub error {
 761   $main::lxdebug->enter_sub();
 762
 763   my ($self, $msg) = @_;
 764
 765   $main::lxdebug->show_backtrace();
 766
 767   if ($ENV{HTTP_USER_AGENT}) {
 768     print qq|Content-Type: text/html
 769
 770 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
 771
 772 <body bgcolor=ffffff>
 773
 774 <h2><font color=red>Error!</font></h2>
 775 <p><b>$msg</b>|;
 776
 777   }
 778
 779   die "Error: $msg\n";
 780
 781   $main::lxdebug->leave_sub();
 782 }
 783
 784 1;
 785