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 # Process a Perl script which updates the database.
 414 # If the script returns 1 then the update was successful.
 415 # Return code "2" means "needs more interaction; remove
 416 # users/nologin and end current request".
 417 # All other return codes are fatal errors.
 418 sub process_perl_script {
 419   $main::lxdebug->enter_sub();
 420
 421   my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
 422
 423   my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
 424
 425   my $file_charset = Common::DEFAULT_CHARSET;
 426
 427   if (ref($version_or_control) eq "HASH") {
 428     $file_charset = $version_or_control->{charset};
 429
 430   } else {
 431     while (<$fh>) {
 432       last if !/^--/;
 433       next if !/^--\s*\@charset:\s*(.+)/;
 434       $file_charset = $1;
 435       last;
 436     }
 437     $fh->seek(0, SEEK_SET);
 438   }
 439
 440   my $contents = join "", <$fh>;
 441   $fh->close();
 442
 443   $db_charset ||= Common::DEFAULT_CHARSET;
 444
 445   my $iconv = SL::Iconv::get_converter($file_charset, $db_charset);
 446
 447   $dbh->begin_work();
 448
 449   # setup dbup_ export vars
 450   my %dbup_myconfig = ();
 451   map({ $dbup_myconfig{$_} = $form->{$_}; }
 452       qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
 453
 454   my $dbup_locale = $::locale;
 455
 456   my $result = eval($contents);
 457
 458   if (1 != $result) {
 459     $dbh->rollback();
 460     $dbh->disconnect();
 461   }
 462
 463   if (!defined($result)) {
 464     print $form->parse_html_template("dbupgrade/error",
 465                                      { "file"  => $filename,
 466                                        "error" => $@ });
 467     ::end_of_request();
 468   } elsif (1 != $result) {
 469     unlink("users/nologin") if (2 == $result);
 470     ::end_of_request();
 471   }
 472
 473   if (ref($version_or_control) eq "HASH") {
 474     $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
 475              $dbh->quote($version_or_control->{"tag"}) . ", " .
 476              $dbh->quote($form->{"login"}) . ")");
 477   } elsif ($version_or_control) {
 478     $dbh->do("UPDATE defaults SET version = " .
 479              $dbh->quote($version_or_control));
 480   }
 481   $dbh->commit();
 482
 483   $main::lxdebug->leave_sub();
 484 }
 485
 486 sub dbdelete {
 487   $main::lxdebug->enter_sub();
 488
 489   my ($self, $form) = @_;
 490   $form->{db} =~ s/\"//g;
 491   my %dbdelete = ('Pg'     => qq|DROP DATABASE "$form->{db}"|,
 492                   'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
 493
 494   $form->{sid} = $form->{dbdefault};
 495   &dbconnect_vars($form, $form->{dbdefault});
 496   my $dbh =
 497     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 498     or $form->dberror;
 499   my $query = $dbdelete{$form->{dbdriver}};
 500   do_query($form, $dbh, $query);
 501
 502   $dbh->disconnect;
 503
 504   $main::lxdebug->leave_sub();
 505 }
 506
 507 sub dbsources_unused {
 508   $main::lxdebug->enter_sub();
 509
 510   my ($self, $form) = @_;
 511
 512   $form->{only_acc_db} = 1;
 513
 514   my %members = $main::auth->read_all_users();
 515   my %dbexcl  = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
 516
 517   $dbexcl{$form->{dbdefault}}             = 1;
 518   $dbexcl{$main::auth->{DB_config}->{db}} = 1;
 519
 520   my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
 521
 522   $main::lxdebug->leave_sub();
 523
 524   return @dbunused;
 525 }
 526
 527 sub dbneedsupdate {
 528   $main::lxdebug->enter_sub();
 529
 530   my ($self, $form) = @_;
 531
 532   my %members  = $main::auth->read_all_users();
 533   my $controls = SL::DBUpgrade2->new($form, $form->{dbdriver})->parse_dbupdate_controls;
 534
 535   my ($query, $sth, %dbs_needing_updates);
 536
 537   foreach my $login (grep /[a-z]/, keys %members) {
 538     my $member = $members{$login};
 539
 540     map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
 541     dbconnect_vars($form, $form->{dbname});
 542
 543     my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
 544
 545     next unless $dbh;
 546
 547     my $version;
 548
 549     $query = qq|SELECT version FROM defaults|;
 550     $sth = prepare_query($form, $dbh, $query);
 551     if ($sth->execute()) {
 552       ($version) = $sth->fetchrow_array();
 553     }
 554     $sth->finish();
 555     $dbh->disconnect();
 556
 557     next unless $version;
 558
 559     if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
 560       my $dbinfo = {};
 561       map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
 562       $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
 563     }
 564   }
 565
 566   $main::lxdebug->leave_sub();
 567
 568   return values %dbs_needing_updates;
 569 }
 570
 571 sub calc_version {
 572   $main::lxdebug->enter_sub(2);
 573
 574   my (@v, $version, $i);
 575
 576   @v = split(/\./, $_[0]);
 577   while (scalar(@v) < 4) {
 578     push(@v, 0);
 579   }
 580   $version = 0;
 581   for ($i = 0; $i < 4; $i++) {
 582     $version *= 1000;
 583     $version += $v[$i];
 584   }
 585
 586   $main::lxdebug->leave_sub(2);
 587   return $version;
 588 }
 589
 590 sub cmp_script_version {
 591   my ($a_from, $a_to, $b_from, $b_to);
 592   my ($i, $res_a, $res_b);
 593   my ($my_a, $my_b) = ($a, $b);
 594
 595   $my_a =~ s/.*-upgrade-//;
 596   $my_a =~ s/.sql$//;
 597   $my_b =~ s/.*-upgrade-//;
 598   $my_b =~ s/.sql$//;
 599   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
 600   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
 601
 602   $res_a = calc_version($my_a_from);
 603   $res_b = calc_version($my_b_from);
 604
 605   if ($res_a == $res_b) {
 606     $res_a = calc_version($my_a_to);
 607     $res_b = calc_version($my_b_to);
 608   }
 609
 610   return $res_a <=> $res_b;
 611 }
 612
 613 sub update_available {
 614   my ($dbdriver, $cur_version) = @_;
 615
 616   local *SQLDIR;
 617
 618   opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
 619   my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
 620   closedir SQLDIR;
 621
 622   return ($#upgradescripts > -1);
 623 }
 624
 625 sub create_schema_info_table {
 626   $main::lxdebug->enter_sub();
 627
 628   my ($self, $form, $dbh) = @_;
 629
 630   my $query = "SELECT tag FROM schema_info LIMIT 1";
 631   if (!$dbh->do($query)) {
 632     $dbh->rollback();
 633     $query =
 634       qq|CREATE TABLE schema_info (| .
 635       qq|  tag text, | .
 636       qq|  login text, | .
 637       qq|  itime timestamp DEFAULT now(), | .
 638       qq|  PRIMARY KEY (tag))|;
 639     $dbh->do($query) || $form->dberror($query);
 640   }
 641
 642   $main::lxdebug->leave_sub();
 643 }
 644
 645 sub dbupdate {
 646   $main::lxdebug->enter_sub();
 647
 648   my ($self, $form) = @_;
 649
 650   local *SQLDIR;
 651
 652   $form->{sid} = $form->{dbdefault};
 653
 654   my @upgradescripts = ();
 655   my $query;
 656   my $rc = -2;
 657
 658   if ($form->{dbupdate}) {
 659
 660     # read update scripts into memory
 661     opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
 662       or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
 663     @upgradescripts =
 664       sort(cmp_script_version
 665            grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
 666                 readdir(SQLDIR)));
 667     closedir(SQLDIR);
 668   }
 669
 670   my $db_charset = $main::dbcharset;
 671   $db_charset ||= Common::DEFAULT_CHARSET;
 672
 673   my $dbupdater = SL::DBUpgrade2->new($form, $form->{dbdriver});
 674
 675   foreach my $db (split(/ /, $form->{dbupdate})) {
 676
 677     next unless $form->{$db};
 678
 679     # strip db from dataset
 680     $db =~ s/^db//;
 681     &dbconnect_vars($form, $db);
 682
 683     my $dbh =
 684       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 685       or $form->dberror;
 686
 687     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 688
 689     # check version
 690     $query = qq|SELECT version FROM defaults|;
 691     my ($version) = selectrow_query($form, $dbh, $query);
 692
 693     next unless $version;
 694
 695     $version = calc_version($version);
 696
 697     foreach my $upgradescript (@upgradescripts) {
 698       my $a = $upgradescript;
 699       $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
 700       my $file_type = $1;
 701
 702       my ($mindb, $maxdb) = split /-/, $a;
 703       my $str_maxdb = $maxdb;
 704       $mindb = calc_version($mindb);
 705       $maxdb = calc_version($maxdb);
 706
 707       next if ($version >= $maxdb);
 708
 709       # if there is no upgrade script exit
 710       last if ($version < $mindb);
 711
 712       # apply upgrade
 713       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
 714       if ($file_type eq "sql") {
 715         $dbupdater->process_query($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 716       } else {
 717         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 718                                    "-upgrade/$upgradescript", $str_maxdb, $db_charset);
 719       }
 720
 721       $version = $maxdb;
 722
 723     }
 724
 725     $rc = 0;
 726     $dbh->disconnect;
 727
 728   }
 729
 730   $main::lxdebug->leave_sub();
 731
 732   return $rc;
 733 }
 734
 735 sub dbupdate2 {
 736   $main::lxdebug->enter_sub();
 737
 738   my ($self, $form, $dbupdater) = @_;
 739
 740   $form->{sid} = $form->{dbdefault};
 741
 742   my @upgradescripts = ();
 743   my ($query, $sth, $tag);
 744   my $rc = -2;
 745
 746   @upgradescripts = $dbupdater->sort_dbupdate_controls;
 747
 748   my $db_charset = $main::dbcharset;
 749   $db_charset ||= Common::DEFAULT_CHARSET;
 750
 751   foreach my $db (split / /, $form->{dbupdate}) {
 752
 753     next unless $form->{$db};
 754
 755     # strip db from dataset
 756     $db =~ s/^db//;
 757     &dbconnect_vars($form, $db);
 758
 759     my $dbh =
 760       DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
 761       or $form->dberror;
 762
 763     $dbh->do($form->{dboptions}) if ($form->{dboptions});
 764
 765     map({ $_->{"applied"} = 0; } @upgradescripts);
 766
 767     $self->create_schema_info_table($form, $dbh);
 768
 769     $query = qq|SELECT tag FROM schema_info|;
 770     $sth = $dbh->prepare($query);
 771     $sth->execute() || $form->dberror($query);
 772     while (($tag) = $sth->fetchrow_array()) {
 773       $dbupdater->{all_controls}->{$tag}->{"applied"} = 1 if (defined($dbupdater->{all_controls}->{$tag}));
 774     }
 775     $sth->finish();
 776
 777     my $all_applied = 1;
 778     foreach (@upgradescripts) {
 779       if (!$_->{"applied"}) {
 780         $all_applied = 0;
 781         last;
 782       }
 783     }
 784
 785     next if ($all_applied);
 786
 787     foreach my $control (@upgradescripts) {
 788       next if ($control->{"applied"});
 789
 790       $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
 791
 792       $control->{"file"} =~ /\.(sql|pl)$/;
 793       my $file_type = $1;
 794
 795       # apply upgrade
 796       $main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}");
 797       print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
 798
 799       if ($file_type eq "sql") {
 800         $dbupdater->process_query($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
 801       } else {
 802         $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
 803                                    "-upgrade2/$control->{file}", $control, $db_charset);
 804       }
 805     }
 806
 807     $rc = 0;
 808     $dbh->disconnect;
 809
 810   }
 811
 812   $main::lxdebug->leave_sub();
 813
 814   return $rc;
 815 }
 816
 817 sub update2_available {
 818   $main::lxdebug->enter_sub();
 819
 820   my ($form, $controls) = @_;
 821
 822   map({ $_->{"applied"} = 0; } values(%{$controls}));
 823
 824   dbconnect_vars($form, $form->{"dbname"});
 825
 826   my $dbh =
 827     DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) ||
 828     $form->dberror;
 829
 830   my ($query, $tag, $sth);
 831
 832   $query = qq|SELECT tag FROM schema_info|;
 833   $sth = $dbh->prepare($query);
 834   if ($sth->execute()) {
 835     while (($tag) = $sth->fetchrow_array()) {
 836       $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
 837     }
 838   }
 839   $sth->finish();
 840   $dbh->disconnect();
 841
 842   map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) }
 843       values(%{$controls}));
 844
 845   $main::lxdebug->leave_sub();
 846   return 0;
 847 }
 848
 849 sub save_member {
 850   $main::lxdebug->enter_sub();
 851
 852   my ($self) = @_;
 853   my $form   = \%main::form;
 854
 855   # format dbconnect and dboptions string
 856   dbconnect_vars($self, $self->{dbname});
 857
 858   map { $self->{$_} =~ s/\r//g; } qw(address signature);
 859
 860   $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
 861
 862   my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
 863   if ($dbh) {
 864     $self->create_employee_entry($form, $dbh, $self, 1);
 865     $dbh->disconnect();
 866   }
 867
 868   $main::lxdebug->leave_sub();
 869 }
 870
 871 sub create_employee_entry {
 872   $main::lxdebug->enter_sub();
 873
 874   my $self            = shift;
 875   my $form            = shift;
 876   my $dbh             = shift;
 877   my $myconfig        = shift;
 878   my $update_existing = shift;
 879
 880   if (!does_table_exist($dbh, 'employee')) {
 881     $main::lxdebug->leave_sub();
 882     return;
 883   }
 884
 885   # add login to employee table if it does not exist
 886   # no error check for employee table, ignore if it does not exist
 887   my ($id)  = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
 888
 889   if (!$id) {
 890     my $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
 891     do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
 892
 893   } elsif ($update_existing) {
 894     my $query = qq|UPDATE employee SET name = ?, workphone = ?, role = 'user' WHERE id = ?|;
 895     do_query($form, $dbh, $query, $myconfig->{name}, $myconfig->{tel}, $id);
 896   }
 897
 898   $main::lxdebug->leave_sub();
 899 }
 900
 901 sub config_vars {
 902   $main::lxdebug->enter_sub();
 903
 904   my @conf = qw(address admin businessnumber company countrycode
 905     currency dateformat dbconnect dbdriver dbhost dbport dboptions
 906     dbname dbuser dbpasswd email fax name numberformat password
 907     printer role sid signature stylesheet tel templates vclimit angebote
 908     bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
 909     taxnumber co_ustid duns menustyle template_format default_media
 910     default_printer_id copies show_form_details favorites
 911     pdonumber sdonumber hide_cvar_search_options mandatory_departments
 912     sepa_creditor_id);
 913
 914   $main::lxdebug->leave_sub();
 915
 916   return @conf;
 917 }
 918
 919 sub error {
 920   $main::lxdebug->enter_sub();
 921
 922   my ($self, $msg) = @_;
 923
 924   $main::lxdebug->show_backtrace();
 925
 926   if ($ENV{HTTP_USER_AGENT}) {
 927     print qq|Content-Type: text/html
 928
 929 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
 930
 931 <body bgcolor=ffffff>
 932
 933 <h2><font color=red>Error!</font></h2>
 934 <p><b>$msg</b>|;
 935
 936   }
 937
 938   die "Error: $msg\n";
 939
 940   $main::lxdebug->leave_sub();
 941 }
 942
 943 1;
 944