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, $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});
 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})->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});
 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       my $file_type = $1;
 628
 629       my ($mindb, $maxdb) = split /-/, $a;
 630       my $str_maxdb = $maxdb;
 631       $mindb = calc_version($mindb);
 632       $maxdb = calc_version($maxdb);
 633
 634       next if ($version >= $maxdb);
 635
 636       # if there is no upgrade script exit
 637       last if ($version < $mindb);
 638
 639       # apply upgrade
 640       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
 641       if ($file_type eq "sql") {
 642         $dbupdater->process_query($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 643       } else {
 644         $dbupdater->process_perl_script($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 645       }
 646
 647       $version = $maxdb;
 648
 649     }
 650
 651     $rc = 0;
 652     $dbh->disconnect;
 653
 654   }
 655
 656   $main::lxdebug->leave_sub();
 657
 658   return $rc;
 659 }
 660
 661 sub dbupdate2 {
 662   $main::lxdebug->enter_sub();
 663
 664   my ($self, $form, $dbupdater) = @_;
 665
 666   $form->{sid} = $form->{dbdefault};
 667
 668   my @upgradescripts = ();
 669   my ($query, $sth, $tag);
 670   my $rc = -2;
 671
 672   @upgradescripts = $dbupdater->sort_dbupdate_controls;
 673
 674   my $db_charset = $main::dbcharset;
 675   $db_charset ||= Common::DEFAULT_CHARSET;
 676
 677   foreach my $db (split / /, $form->{dbupdate}) {
 678
 679     next unless $form->{$db};
 680
 681     # strip db from dataset
 682     $db =~ s/^db//;
 683     &dbconnect_vars($form, $db);
 684
 685     my $dbh =
 686       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 687       or $form->dberror;
 688
 689     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 690
 691     map({ $_->{"applied"} = 0; } @upgradescripts);
 692
 693     $self->create_schema_info_table($form, $dbh);
 694
 695     $query = qq|SELECT tag FROM schema_info|;
 696     $sth = $dbh->prepare($query);
 697     $sth->execute() || $form->dberror($query);
 698     while (($tag) = $sth->fetchrow_array()) {
 699       $dbupdater->{all_controls}->{$tag}->{"applied"} = 1 if (defined($dbupdater->{all_controls}->{$tag}));
 700     }
 701     $sth->finish();
 702
 703     my $all_applied = 1;
 704     foreach (@upgradescripts) {
 705       if (!$_->{"applied"}) {
 706         $all_applied = 0;
 707         last;
 708       }
 709     }
 710
 711     next if ($all_applied);
 712
 713     foreach my $control (@upgradescripts) {
 714       next if ($control->{"applied"});
 715
 716       $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
 717
 718       $control->{"file"} =~ /\.(sql|pl)$/;
 719       my $file_type = $1;
 720
 721       # apply upgrade
 722       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
 723       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 724
 725       if ($file_type eq "sql") {
 726         $dbupdater->process_query($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
 727       } else {
 728         $dbupdater->process_perl_script($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
 729       }
 730     }
 731
 732     $rc = 0;
 733     $dbh->disconnect;
 734
 735   }
 736
 737   $main::lxdebug->leave_sub();
 738
 739   return $rc;
 740 }
 741
 742 sub update2_available {
 743   $main::lxdebug->enter_sub();
 744
 745   my ($form, $controls) = @_;
 746
 747   map({ $_->{"applied"} = 0; } values(%{$controls}));
 748
 749   dbconnect_vars($form, $form->{"dbname"});
 750
 751   my $dbh =
 752     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
 753     $form->dberror;
 754
 755   my ($query, $tag, $sth);
 756
 757   $query = qq|SELECT tag FROM schema_info|;
 758   $sth = $dbh->prepare($query);
 759   if ($sth->execute()) {
 760     while (($tag) = $sth->fetchrow_array()) {
 761       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 762     }
 763   }
 764   $sth->finish();
 765   $dbh->disconnect();
 766
 767   map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
 768       values(%{$controls}));
 769
 770   $main::lxdebug->leave_sub();
 771   return 0;
 772 }
 773
 774 sub save_member {
 775   $main::lxdebug->enter_sub();
 776
 777   my ($self) = @_;
 778   my $form   = \%main::form;
 779
 780   # format dbconnect and dboptions string
 781   dbconnect_vars($self, $self->{dbname});
 782
 783   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 784
 785   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 786
 787   my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
 788   if ($dbh) {
 789     $self->create_employee_entry($form, $dbh, $self, 1);
 790     $dbh->disconnect();
 791   }
 792
 793   $main::lxdebug->leave_sub();
 794 }
 795
 796 sub create_employee_entry {
 797   $main::lxdebug->enter_sub();
 798
 799   my $self            = shift;
 800   my $form            = shift;
 801   my $dbh             = shift;
 802   my $myconfig        = shift;
 803   my $update_existing = shift;
 804
 805   if (!does_table_exist($dbh, 'employee')) {
 806     $main::lxdebug->leave_sub();
 807     return;
 808   }
 809
 810   # add login to employee table if it does not exist
 811   # no error check for employee table, ignore if it does not exist
 812   my ($id)  = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 813
 814   if (!$id) {
 815     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 816     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 817
 818   } elsif ($update_existing) {
 819     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
 820     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 821   }
 822
 823   $main::lxdebug->leave_sub();
 824 }
 825
 826 sub config_vars {
 827   $main::lxdebug->enter_sub();
 828
 829   my @conf = qw(address admin businessnumber company countrycode
 830     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 831     dbname dbuser dbpasswd email fax name numberformat password
 832     printer role sid signature stylesheet tel templates vclimit angebote
 833     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 834     taxnumber co_ustid duns menustyle template_format default_media
 835     default_printer_id copies show_form_details favorites
 836     pdonumber sdonumber hide_cvar_search_options mandatory_departments
 837     sepa_creditor_id);
 838
 839   $main::lxdebug->leave_sub();
 840
 841   return @conf;
 842 }
 843
 844 sub error {
 845   $main::lxdebug->enter_sub();
 846
 847   my ($self, $msg) = @_;
 848
 849   $main::lxdebug->show_backtrace();
 850
 851   if ($ENV{HTTP_USER_AGENT}) {
 852     print qq|Content-Type: text/html
 853
 854 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
 855
 856 <body bgcolor=ffffff>
 857
 858 <h2><font color=red>Error!</font></h2>
 859 <p><b>$msg</b>|;
 860
 861   }
 862
 863   die "Error: $msg\n";
 864
 865   $main::lxdebug->leave_sub();
 866 }
 867
 868 1;
 869