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     $dbh->disconnect;
 125
 126     $rc = 0;
 127
 128     my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $myconfig{dbdriver});
 129     my $controls  = $dbupdater->parse_dbupdate_controls;
 130
 131     map({ $form->{$_} = $myconfig{$_} }
 132         qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
 133
 134     if (update_available($myconfig{"dbdriver"}, $dbversion) ||
 135         update2_available($form, $controls)) {
 136
 137       $form->{"stylesheet"} = "lx-office-erp.css";
 138       $form->{"title"} = $main::locale->text("Dataset upgrade");
 139       $form->header();
 140       print $form->parse_html_template("dbupgrade/header");
 141
 142       $form->{dbupdate} = "db$myconfig{dbname}";
 143       $form->{ $form->{dbupdate} } = 1;
 144
 145       if ($form->{"show_dbupdate_warning"}) {
 146         print $form->parse_html_template("dbupgrade/warning");
 147         ::end_of_request();
 148       }
 149
 150       # update the tables
 151       if (!open(FH, ">$main::userspath/nologin")) {
 152         $form->show_generic_error($main::locale->text('A temporary file could not be created. ' .
 153                                                       'Please verify that the directory "#1" is writeable by the webserver.',
 154                                                       $main::userspath),
 155                                   'back_button' => 1);
 156       }
 157
 158       # required for Oracle
 159       $form->{dbdefault} = $sid;
 160
 161       # ignore HUP, QUIT in case the webserver times out
 162       $SIG{HUP}  = 'IGNORE';
 163       $SIG{QUIT} = 'IGNORE';
 164
 165       $self->dbupdate($form);
 166       $self->dbupdate2($form, $dbupdater);
 167
 168       close(FH);
 169
 170       # remove lock file
 171       unlink("$main::userspath/nologin");
 172
 173       my $menufile =
 174         $self->{"menustyle"} eq "v3" ? "menuv3.pl" :
 175         $self->{"menustyle"} eq "neu" ? "menunew.pl" :
 176         $self->{"menustyle"} eq "js" ? "menujs.pl" :
 177         $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
 178         "menu.pl";
 179
 180       print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
 181
 182       $rc = -2;
 183
 184     }
 185   }
 186
 187   $main::lxdebug->leave_sub();
 188
 189   return $rc;
 190 }
 191
 192 sub dbconnect_vars {
 193   $main::lxdebug->enter_sub();
 194
 195   my ($form, $db) = @_;
 196
 197   my %dboptions = (
 198         'Pg' => { 'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
 199                   'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
 200                   'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
 201                   'mm-dd-yy'   => 'set DateStyle to \'POSTGRES, US\'',
 202                   'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
 203                   'dd-mm-yy'   => 'set DateStyle to \'POSTGRES, EUROPEAN\'',
 204                   'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
 205         },
 206         'Oracle' => {
 207           'yy-mm-dd'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'',
 208           'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'',
 209           'mm/dd/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'',
 210           'mm-dd-yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'',
 211           'dd/mm/yy'   => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/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         });
 215
 216   $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} };
 217
 218   if ($form->{dbdriver} eq 'Pg') {
 219     $form->{dbconnect} = "dbi:Pg:dbname=$db";
 220   }
 221
 222   if ($form->{dbdriver} eq 'Oracle') {
 223     $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}";
 224   }
 225
 226   if ($form->{dbhost}) {
 227     $form->{dbconnect} .= ";host=$form->{dbhost}";
 228   }
 229   if ($form->{dbport}) {
 230     $form->{dbconnect} .= ";port=$form->{dbport}";
 231   }
 232
 233   $main::lxdebug->leave_sub();
 234 }
 235
 236 sub dbdrivers {
 237   $main::lxdebug->enter_sub();
 238
 239   my @drivers = DBI->available_drivers();
 240
 241   $main::lxdebug->leave_sub();
 242
 243   return (grep { /(Pg|Oracle)/ } @drivers);
 244 }
 245
 246 sub dbsources {
 247   $main::lxdebug->enter_sub();
 248
 249   my ($self, $form) = @_;
 250
 251   my @dbsources = ();
 252   my ($sth, $query);
 253
 254   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
 255   $form->{sid} = $form->{dbdefault};
 256   &dbconnect_vars($form, $form->{dbdefault});
 257
 258   my $dbh =
 259     DBI->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 =
 277           DBI->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                = DBI->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     DBI->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 = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 393     or $form->dberror;
 394
 395   my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
 396   $db_charset ||= Common::DEFAULT_CHARSET;
 397
 398   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
 399   # create the tables
 400   $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
 401
 402   # load chart of accounts
 403   $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
 404
 405   $query = "UPDATE defaults SET coa = ?";
 406   do_query($form, $dbh, $query, $form->{chart});
 407
 408   $dbh->disconnect;
 409
 410   $main::lxdebug->leave_sub();
 411 }
 412
 413 sub dbdelete {
 414   $main::lxdebug->enter_sub();
 415
 416   my ($self, $form) = @_;
 417   $form->{db} =~ s/\"//g;
 418   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 419                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
 420
 421   $form->{sid} = $form->{dbdefault};
 422   &dbconnect_vars($form, $form->{dbdefault});
 423   my $dbh =
 424     DBI->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 $controls = 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 = DBI->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     $dbh->disconnect();
 483
 484     next unless $version;
 485
 486     if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
 487       my $dbinfo = {};
 488       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
 489       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
 490     }
 491   }
 492
 493   $main::lxdebug->leave_sub();
 494
 495   return values %dbs_needing_updates;
 496 }
 497
 498 sub calc_version {
 499   $main::lxdebug->enter_sub(2);
 500
 501   my (@v, $version, $i);
 502
 503   @v = split(/\./, $_[0]);
 504   while (scalar(@v) < 4) {
 505     push(@v, 0);
 506   }
 507   $version = 0;
 508   for ($i = 0; $i < 4; $i++) {
 509     $version *= 1000;
 510     $version += $v[$i];
 511   }
 512
 513   $main::lxdebug->leave_sub(2);
 514   return $version;
 515 }
 516
 517 sub cmp_script_version {
 518   my ($a_from, $a_to, $b_from, $b_to);
 519   my ($i, $res_a, $res_b);
 520   my ($my_a, $my_b) = ($a, $b);
 521
 522   $my_a =~ s/.*-upgrade-//;
 523   $my_a =~ s/.sql$//;
 524   $my_b =~ s/.*-upgrade-//;
 525   $my_b =~ s/.sql$//;
 526   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
 527   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
 528
 529   $res_a = calc_version($my_a_from);
 530   $res_b = calc_version($my_b_from);
 531
 532   if ($res_a == $res_b) {
 533     $res_a = calc_version($my_a_to);
 534     $res_b = calc_version($my_b_to);
 535   }
 536
 537   return $res_a <=> $res_b;
 538 }
 539
 540 sub update_available {
 541   my ($dbdriver, $cur_version) = @_;
 542
 543   local *SQLDIR;
 544
 545   opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
 546   my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
 547   closedir SQLDIR;
 548
 549   return ($#upgradescripts > -1);
 550 }
 551
 552 sub create_schema_info_table {
 553   $main::lxdebug->enter_sub();
 554
 555   my ($self, $form, $dbh) = @_;
 556
 557   my $query = "SELECT tag FROM schema_info LIMIT 1";
 558   if (!$dbh->do($query)) {
 559     $dbh->rollback();
 560     $query =
 561       qq|CREATE TABLE schema_info (| .
 562       qq|  tag text, | .
 563       qq|  login text, | .
 564       qq|  itime timestamp DEFAULT now(), | .
 565       qq|  PRIMARY KEY (tag))|;
 566     $dbh->do($query) || $form->dberror($query);
 567   }
 568
 569   $main::lxdebug->leave_sub();
 570 }
 571
 572 sub dbupdate {
 573   $main::lxdebug->enter_sub();
 574
 575   my ($self, $form) = @_;
 576
 577   local *SQLDIR;
 578
 579   $form->{sid} = $form->{dbdefault};
 580
 581   my @upgradescripts = ();
 582   my $query;
 583   my $rc = -2;
 584
 585   if ($form->{dbupdate}) {
 586
 587     # read update scripts into memory
 588     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
 589       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 590     @upgradescripts =
 591       sort(cmp_script_version
 592            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
 593                 readdir(SQLDIR)));
 594     closedir(SQLDIR);
 595   }
 596
 597   my $db_charset = $main::dbcharset;
 598   $db_charset ||= Common::DEFAULT_CHARSET;
 599
 600   my $dbupdater = SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver});
 601
 602   foreach my $db (split(/ /, $form->{dbupdate})) {
 603
 604     next unless $form->{$db};
 605
 606     # strip db from dataset
 607     $db =~ s/^db//;
 608     &dbconnect_vars($form, $db);
 609
 610     my $dbh =
 611       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 612       or $form->dberror;
 613
 614     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 615
 616     # check version
 617     $query = qq|SELECT version FROM defaults|;
 618     my ($version) = selectrow_query($form, $dbh, $query);
 619
 620     next unless $version;
 621
 622     $version = calc_version($version);
 623
 624     foreach my $upgradescript (@upgradescripts) {
 625       my $a = $upgradescript;
 626       $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
 627
 628       my ($mindb, $maxdb) = split /-/, $a;
 629       my $str_maxdb = $maxdb;
 630       $mindb = calc_version($mindb);
 631       $maxdb = calc_version($maxdb);
 632
 633       next if ($version >= $maxdb);
 634
 635       # if there is no upgrade script exit
 636       last if ($version < $mindb);
 637
 638       # apply upgrade
 639       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
 640       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 641
 642       $version = $maxdb;
 643
 644     }
 645
 646     $rc = 0;
 647     $dbh->disconnect;
 648
 649   }
 650
 651   $main::lxdebug->leave_sub();
 652
 653   return $rc;
 654 }
 655
 656 sub dbupdate2 {
 657   $main::lxdebug->enter_sub();
 658
 659   my ($self, $form, $dbupdater) = @_;
 660
 661   $form->{sid} = $form->{dbdefault};
 662
 663   my @upgradescripts = ();
 664   my ($query, $sth, $tag);
 665   my $rc = -2;
 666
 667   @upgradescripts = $dbupdater->sort_dbupdate_controls;
 668
 669   my $db_charset = $main::dbcharset;
 670   $db_charset ||= Common::DEFAULT_CHARSET;
 671
 672   foreach my $db (split / /, $form->{dbupdate}) {
 673
 674     next unless $form->{$db};
 675
 676     # strip db from dataset
 677     $db =~ s/^db//;
 678     &dbconnect_vars($form, $db);
 679
 680     my $dbh =
 681       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 682       or $form->dberror;
 683
 684     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 685
 686     map({ $_->{"applied"} = 0; } @upgradescripts);
 687
 688     $self->create_schema_info_table($form, $dbh);
 689
 690     $query = qq|SELECT tag FROM schema_info|;
 691     $sth = $dbh->prepare($query);
 692     $sth->execute() || $form->dberror($query);
 693     while (($tag) = $sth->fetchrow_array()) {
 694       $dbupdater->{all_controls}->{$tag}->{"applied"} = 1 if (defined($dbupdater->{all_controls}->{$tag}));
 695     }
 696     $sth->finish();
 697
 698     my $all_applied = 1;
 699     foreach (@upgradescripts) {
 700       if (!$_->{"applied"}) {
 701         $all_applied = 0;
 702         last;
 703       }
 704     }
 705
 706     next if ($all_applied);
 707
 708     foreach my $control (@upgradescripts) {
 709       next if ($control->{"applied"});
 710
 711       $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
 712
 713       $control->{"file"} =~ /\.(sql|pl)$/;
 714       my $file_type = $1;
 715
 716       # apply upgrade
 717       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
 718       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 719
 720       $dbupdater->process_file($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
 721     }
 722
 723     $rc = 0;
 724     $dbh->disconnect;
 725
 726   }
 727
 728   $main::lxdebug->leave_sub();
 729
 730   return $rc;
 731 }
 732
 733 sub update2_available {
 734   $main::lxdebug->enter_sub();
 735
 736   my ($form, $controls) = @_;
 737
 738   map({ $_->{"applied"} = 0; } values(%{$controls}));
 739
 740   dbconnect_vars($form, $form->{"dbname"});
 741
 742   my $dbh =
 743     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
 744     $form->dberror;
 745
 746   my ($query, $tag, $sth);
 747
 748   $query = qq|SELECT tag FROM schema_info|;
 749   $sth = $dbh->prepare($query);
 750   if ($sth->execute()) {
 751     while (($tag) = $sth->fetchrow_array()) {
 752       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 753     }
 754   }
 755   $sth->finish();
 756   $dbh->disconnect();
 757
 758   map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
 759       values(%{$controls}));
 760
 761   $main::lxdebug->leave_sub();
 762   return 0;
 763 }
 764
 765 sub save_member {
 766   $main::lxdebug->enter_sub();
 767
 768   my ($self) = @_;
 769   my $form   = \%main::form;
 770
 771   # format dbconnect and dboptions string
 772   dbconnect_vars($self, $self->{dbname});
 773
 774   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 775
 776   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 777
 778   my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
 779   if ($dbh) {
 780     $self->create_employee_entry($form, $dbh, $self, 1);
 781     $dbh->disconnect();
 782   }
 783
 784   $main::lxdebug->leave_sub();
 785 }
 786
 787 sub create_employee_entry {
 788   $main::lxdebug->enter_sub();
 789
 790   my $self            = shift;
 791   my $form            = shift;
 792   my $dbh             = shift;
 793   my $myconfig        = shift;
 794   my $update_existing = shift;
 795
 796   if (!does_table_exist($dbh, 'employee')) {
 797     $main::lxdebug->leave_sub();
 798     return;
 799   }
 800
 801   # add login to employee table if it does not exist
 802   # no error check for employee table, ignore if it does not exist
 803   my ($id)  = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 804
 805   if (!$id) {
 806     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 807     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 808
 809   } elsif ($update_existing) {
 810     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
 811     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 812   }
 813
 814   $main::lxdebug->leave_sub();
 815 }
 816
 817 sub config_vars {
 818   $main::lxdebug->enter_sub();
 819
 820   my @conf = qw(address admin businessnumber company countrycode
 821     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 822     dbname dbuser dbpasswd email fax name numberformat password
 823     printer role sid signature stylesheet tel templates vclimit angebote
 824     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 825     taxnumber co_ustid duns menustyle template_format default_media
 826     default_printer_id copies show_form_details favorites
 827     pdonumber sdonumber hide_cvar_search_options mandatory_departments
 828     sepa_creditor_id);
 829
 830   $main::lxdebug->leave_sub();
 831
 832   return @conf;
 833 }
 834
 835 sub error {
 836   $main::lxdebug->enter_sub();
 837
 838   my ($self, $msg) = @_;
 839
 840   $main::lxdebug->show_backtrace();
 841
 842   if ($ENV{HTTP_USER_AGENT}) {
 843     print qq|Content-Type: text/html
 844
 845 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
 846
 847 <body bgcolor=ffffff>
 848
 849 <h2><font color=red>Error!</font></h2>
 850 <p><b>$msg</b>|;
 851
 852   }
 853
 854   die "Error: $msg\n";
 855
 856   $main::lxdebug->leave_sub();
 857 }
 858
 859 1;
 860