package User;
+use IO::File;
+use Fcntl qw(:seek);
+
+use SL::Auth;
use SL::DBUpgrade2;
use SL::DBUtils;
+use SL::Iconv;
+use SL::Inifile;
sub new {
$main::lxdebug->enter_sub();
- my ($type, $memfile, $login) = @_;
+ my ($type, $login) = @_;
+
my $self = {};
if ($login ne "") {
- &error("", "$memfile locked!") if (-f "${memfile}.LCK");
-
- open(MEMBER, "$memfile") or &error("", "$memfile : $!");
-
- while (<MEMBER>) {
- if (/^\[$login\]/) {
- while (<MEMBER>) {
- last if /^\[/;
- next if /^(#|\s)/;
-
- # remove comments
- s/\s#.*//g;
-
- # remove any trailing whitespace
- s/^\s*(.*?)\s*$/$1/;
-
- ($key, $value) = split(/=/, $_, 2);
-
- if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) {
- $value = "lx-office-erp.css";
- }
-
- $self->{$key} = $value;
- }
-
- $self->{login} = $login;
-
- last;
- }
- }
- close MEMBER;
+ my %user_data = $main::auth->read_user($login);
+ map { $self->{$_} = $user_data{$_} } keys %user_data;
}
$main::lxdebug->leave_sub();
+
bless $self, $type;
}
sub country_codes {
$main::lxdebug->enter_sub();
+ local *DIR;
+
my %cc = ();
my @language = ();
sub login {
$main::lxdebug->enter_sub();
- my ($self, $form, $userspath) = @_;
+ my ($self, $form) = @_;
+
+ local *FH;
my $rc = -3;
if ($self->{login}) {
-
- if ($self->{password}) {
- if ($form->{hashed_password}) {
- $form->{password} = $form->{hashed_password};
- } else {
- $form->{password} = crypt($form->{password},
- substr($self->{login}, 0, 2));
- }
- if ($self->{password} ne $form->{password}) {
- $main::lxdebug->leave_sub();
- return -1;
- }
- }
-
- unless (-e "$userspath/$self->{login}.conf") {
- $self->create_config("$userspath/$self->{login}.conf");
- }
-
- do "$userspath/$self->{login}.conf";
- $myconfig{dbpasswd} = unpack('u', $myconfig{dbpasswd});
+ my %myconfig = $main::auth->read_user($self->{login});
# check if database is down
my $dbh =
my ($dbversion) = $sth->fetchrow_array;
$sth->finish;
- # add login to employee table if it does not exist
- # no error check for employee table, ignore if it does not exist
- $query = qq|SELECT id FROM employee WHERE login = ?|;
- my ($login) = selectrow_query($form, $dbh, $query, $self->{login});
-
- if (!$login) {
- $query = qq|INSERT INTO employee (login, name, workphone, role)| .
- qq|VALUES (?, ?, ?, ?)|;
- my @values = ($self->{login}, $myconfig{name}, $myconfig{tel}, "user");
- do_query($form, $dbh, $query, @values);
- }
+ $self->create_employee_entry($form, $dbh, \%myconfig);
$self->create_schema_info_table($form, $dbh);
parse_dbupdate_controls($form, $myconfig{"dbdriver"});
map({ $form->{$_} = $myconfig{$_} }
- qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect));
+ qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
if (update_available($myconfig{"dbdriver"}, $dbversion) ||
update2_available($form, $controls)) {
$form->{"stylesheet"} = "lx-office-erp.css";
$form->{"title"} = $main::locale->text("Dataset upgrade");
$form->header();
- print($form->parse_html_template("dbupgrade/header"));
+ print $form->parse_html_template("dbupgrade/header");
$form->{dbupdate} = "db$myconfig{dbname}";
$form->{ $form->{dbupdate} } = 1;
if ($form->{"show_dbupdate_warning"}) {
- print($form->parse_html_template("dbupgrade/warning"));
+ print $form->parse_html_template("dbupgrade/warning");
exit(0);
}
# update the tables
- open(FH, ">$userspath/nologin") or die("$!");
+ open(FH, ">$main::userspath/nologin") or die("$!");
# required for Oracle
$form->{dbdefault} = $sid;
$self->dbupdate($form);
$self->dbupdate2($form, $controls);
+ close(FH);
+
# remove lock file
- unlink("$userspath/nologin");
+ unlink("$main::userspath/nologin");
my $menufile =
$self->{"menustyle"} eq "v3" ? "menuv3.pl" :
$self->{"menustyle"} eq "neu" ? "menunew.pl" :
+ $self->{"menustyle"} eq "xml" ? "menuXML.pl" :
"menu.pl";
- print($form->parse_html_template("dbupgrade/footer",
- { "menufile" => $menufile }));
+ print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile });
$rc = -2;
$dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
or $form->dberror;
+ my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
+ $db_charset ||= Common::DEFAULT_CHARSET;
+
# create the tables
- my $filename = qq|sql/lx-office.sql|;
- $self->process_query($form, $dbh, $filename);
+ $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
# load chart of accounts
- $filename = qq|sql/$form->{chart}-chart.sql|;
- $self->process_query($form, $dbh, $filename);
+ $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
$query = "UPDATE defaults SET coa = ?";
do_query($form, $dbh, $query, $form->{chart});
sub process_perl_script {
$main::lxdebug->enter_sub();
- my ($self, $form, $dbh, $filename, $version_or_control) = @_;
+ my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
+
+ my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
+
+ my $file_charset = Common::DEFAULT_CHARSET;
+
+ if (ref($version_or_control) eq "HASH") {
+ $file_charset = $version_or_control->{charset};
- open(FH, "$filename") or $form->error("$filename : $!\n");
- my $contents = join("", <FH>);
- close(FH);
+ } else {
+ while (<$fh>) {
+ last if !/^--/;
+ next if !/^--\s*\@charset:\s*(.+)/;
+ $file_charset = $1;
+ last;
+ }
+ $fh->seek(0, SEEK_SET);
+ }
+
+ my $contents = join "", <$fh>;
+ $fh->close();
+
+ $db_charset ||= Common::DEFAULT_CHARSET;
+
+ my $iconv = SL::Iconv::get_converter($file_charset, $db_charset);
$dbh->begin_work();
}
if (!defined($result)) {
- print($form->parse_html_template("dbupgrade/error",
- { "file" => $filename,
- "error" => $@ }));
+ print $form->parse_html_template("dbupgrade/error",
+ { "file" => $filename,
+ "error" => $@ });
exit(0);
} elsif (1 != $result) {
unlink("users/nologin") if (2 == $result);
sub process_query {
$main::lxdebug->enter_sub();
- my ($self, $form, $dbh, $filename, $version_or_control) = @_;
+ my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
- open(FH, "$filename") or $form->error("$filename : $!\n");
+ my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
my $query = "";
my $sth;
my @quote_chars;
+ my $file_charset = Common::DEFAULT_CHARSET;
+ while (<$fh>) {
+ last if !/^--/;
+ next if !/^--\s*\@charset:\s*(.+)/;
+ $file_charset = $1;
+ last;
+ }
+ $fh->seek(0, SEEK_SET);
+
+ $db_charset ||= Common::DEFAULT_CHARSET;
+
$dbh->begin_work();
- while (<FH>) {
+ while (<$fh>) {
+ $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
# Remove DOS and Unix style line endings.
chomp;
}
$dbh->commit();
- close FH;
+ $fh->close();
$main::lxdebug->leave_sub();
}
sub dbsources_unused {
$main::lxdebug->enter_sub();
- my ($self, $form, $memfile) = @_;
-
- my @dbexcl = ();
- my @dbsources = ();
-
- $form->error('File locked!') if (-f "${memfile}.LCK");
-
- # open members file
- open(FH, "$memfile") or $form->error("$memfile : $!");
-
- while (<FH>) {
- if (/^dbname=/) {
- my ($null, $item) = split(/=/);
- push @dbexcl, $item;
- }
- }
-
- close FH;
+ my ($self, $form) = @_;
$form->{only_acc_db} = 1;
- my @db = &dbsources("", $form);
- push @dbexcl, $form->{dbdefault};
+ my %members = $main::auth->read_all_users();
+ my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members;
- foreach $item (@db) {
- unless (grep /$item$/, @dbexcl) {
- push @dbsources, $item;
- }
- }
+ $dbexcl{$form->{dbdefault}} = 1;
+ $dbexcl{$main::auth->{DB_config}->{db}} = 1;
+
+ my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form);
$main::lxdebug->leave_sub();
- return @dbsources;
+ return @dbunused;
}
sub dbneedsupdate {
my ($self, $form) = @_;
- my %dbsources = ();
- my $query;
+ my %members = $main::auth->read_all_users();
+ my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
- $form->{sid} = $form->{dbdefault};
- &dbconnect_vars($form, $form->{dbdefault});
+ my ($query, $sth, %dbs_needing_updates);
- my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
- or $form->dberror;
-
- if ($form->{dbdriver} eq 'Pg') {
-
- $query =
- qq|SELECT d.datname FROM pg_database d, pg_user u | .
- qq|WHERE d.datdba = u.usesysid AND u.usename = ?|;
- my $sth = prepare_execute_query($form, $dbh, $query, $form->{dbuser});
+ foreach my $login (grep /[a-z]/, keys %members) {
+ my $member = $members{$login};
- while (my ($db) = $sth->fetchrow_array) {
+ map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
+ dbconnect_vars($form, $form->{dbname});
- next if ($db =~ /^template/);
+ my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
- &dbconnect_vars($form, $db);
+ next unless $dbh;
- my $dbh2 =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
- or $form->dberror;
+ my $version;
- $query =
- qq|SELECT tablename FROM pg_tables | .
- qq|WHERE tablename = 'defaults'|;
- my $sth2 = prepare_execute_query($form, $dbh, $query);
-
- if ($sth2->fetchrow_array) {
- $query = qq|SELECT version FROM defaults|;
- my ($version) = selectrow_query($form, $dbh2, $query);
- $dbsources{$db} = $version;
- }
- $sth2->finish;
- $dbh2->disconnect;
+ $query = qq|SELECT version FROM defaults|;
+ $sth = prepare_query($form, $dbh, $query);
+ if ($sth->execute()) {
+ ($version) = $sth->fetchrow_array();
}
- $sth->finish;
- }
-
- if ($form->{dbdriver} eq 'Oracle') {
- $query =
- qq|SELECT owner FROM dba_objects |.
- qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
-
- $sth = $dbh->prepare($query);
- $sth->execute || $form->dberror($query);
-
- while (my ($db) = $sth->fetchrow_array) {
-
- $form->{dbuser} = $db;
- &dbconnect_vars($form, $db);
-
- my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
- or $form->dberror;
+ $sth->finish();
+ $dbh->disconnect();
- $query = qq|SELECT version FROM defaults|;
- my $sth = $dbh->prepare($query);
- $sth->execute;
+ next unless $version;
- if (my ($version) = $sth->fetchrow_array) {
- $dbsources{$db} = $version;
- }
- $sth->finish;
- $dbh->disconnect;
+ if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) {
+ my $dbinfo = {};
+ map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member };
+ $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo;
}
- $sth->finish;
}
- $dbh->disconnect;
-
$main::lxdebug->leave_sub();
- return %dbsources;
+ return values %dbs_needing_updates;
}
sub calc_version {
sub update_available {
my ($dbdriver, $cur_version) = @_;
- opendir(SQLDIR, "sql/${dbdriver}-upgrade")
- or &error("", "sql/${dbdriver}-upgrade: $!");
- my @upgradescripts =
- grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/,
- readdir(SQLDIR));
- closedir(SQLDIR);
+ local *SQLDIR;
+
+ opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!");
+ my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR;
+ closedir SQLDIR;
return ($#upgradescripts > -1);
}
my $query = "SELECT tag FROM schema_info LIMIT 1";
if (!$dbh->do($query)) {
+ $dbh->rollback();
$query =
qq|CREATE TABLE schema_info (| .
qq| tag text, | .
my ($self, $form) = @_;
+ local *SQLDIR;
+
$form->{sid} = $form->{dbdefault};
my @upgradescripts = ();
closedir(SQLDIR);
}
+ my $db_charset = $main::dbcharset;
+ $db_charset ||= Common::DEFAULT_CHARSET;
+
foreach my $db (split(/ /, $form->{dbupdate})) {
next unless $form->{$db};
DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
or $form->dberror;
+ $dbh->do($form->{dboptions}) if ($form->{dboptions});
+
# check version
$query = qq|SELECT version FROM defaults|;
my ($version) = selectrow_query($form, $dbh, $query);
foreach my $upgradescript (@upgradescripts) {
my $a = $upgradescript;
- $a =~ s/^$form->{dbdriver}-upgrade-|\.(sql|pl)$//g;
+ $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g;
my $file_type = $1;
my ($mindb, $maxdb) = split /-/, $a;
$main::lxdebug->message(DEBUG2, "Applying Update $upgradescript");
if ($file_type eq "sql") {
$self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
- "-upgrade/$upgradescript", $str_maxdb);
+ "-upgrade/$upgradescript", $str_maxdb, $db_charset);
} else {
$self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
- "-upgrade/$upgradescript", $str_maxdb);
+ "-upgrade/$upgradescript", $str_maxdb, $db_charset);
}
$version = $maxdb;
@upgradescripts = sort_dbupdate_controls($controls);
+ my $db_charset = $main::dbcharset;
+ $db_charset ||= Common::DEFAULT_CHARSET;
+
foreach my $db (split / /, $form->{dbupdate}) {
next unless $form->{$db};
DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
or $form->dberror;
+ $dbh->do($form->{dboptions}) if ($form->{dboptions});
+
map({ $_->{"applied"} = 0; } @upgradescripts);
+ $self->create_schema_info_table($form, $dbh);
+
$query = qq|SELECT tag FROM schema_info|;
$sth = $dbh->prepare($query);
$sth->execute() || $form->dberror($query);
foreach my $control (@upgradescripts) {
next if ($control->{"applied"});
+ $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
+
$control->{"file"} =~ /\.(sql|pl)$/;
my $file_type = $1;
# apply upgrade
$main::lxdebug->message(DEBUG2, "Applying Update $control->{file}");
- print($form->parse_html_template("dbupgrade/upgrade_message2",
- $control));
+ print $form->parse_html_template("dbupgrade/upgrade_message2", $control);
if ($file_type eq "sql") {
$self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
- "-upgrade2/$control->{file}", $control);
+ "-upgrade2/$control->{file}", $control, $db_charset);
} else {
$self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
- "-upgrade2/$control->{file}", $control);
+ "-upgrade2/$control->{file}", $control, $db_charset);
}
}
$query = qq|SELECT tag FROM schema_info|;
$sth = $dbh->prepare($query);
- $sth->execute() || $form->dberror($query);
- while (($tag) = $sth->fetchrow_array()) {
- $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
+ if ($sth->execute()) {
+ while (($tag) = $sth->fetchrow_array()) {
+ $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
+ }
}
$sth->finish();
$dbh->disconnect();
return 0;
}
-sub create_config {
+sub save_member {
$main::lxdebug->enter_sub();
- my ($self, $filename) = @_;
-
- @config = &config_vars;
+ my ($self) = @_;
- open(CONF, ">$filename") or $self->error("$filename : $!");
+ # format dbconnect and dboptions string
+ dbconnect_vars($self, $self->{dbname});
- # create the config file
- print CONF qq|# configuration file for $self->{login}
+ map { $self->{$_} =~ s/\r//g; } qw(address signature);
-\%myconfig = (
-|;
+ $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars());
- foreach $key (sort @config) {
- $self->{$key} =~ s/\'/\\\'/g;
- print CONF qq| $key => '$self->{$key}',\n|;
+ my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd});
+ if ($dbh) {
+ $self->create_employee_entry($form, $dbh, $self);
+ $dbh->disconnect();
}
- print CONF qq|);\n\n|;
-
- close CONF;
-
$main::lxdebug->leave_sub();
}
-sub save_member {
+sub create_employee_entry {
$main::lxdebug->enter_sub();
- my ($self, $memberfile, $userspath) = @_;
-
- my $newmember = 1;
-
- # format dbconnect and dboptions string
- &dbconnect_vars($self, $self->{dbname});
-
- $self->error('File locked!') if (-f "${memberfile}.LCK");
- open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!");
- close(FH);
-
- open(CONF, "+<$memberfile") or $self->error("$memberfile : $!");
+ my $self = shift;
+ my $form = shift;
+ my $dbh = shift;
+ my $myconfig = shift;
- @config = <CONF>;
+ # add login to employee table if it does not exist
+ # no error check for employee table, ignore if it does not exist
+ my ($login) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login});
- seek(CONF, 0, 0);
- truncate(CONF, 0);
-
- while ($line = shift @config) {
- if ($line =~ /^\[$self->{login}\]/) {
- $newmember = 0;
- last;
- }
- print CONF $line;
- }
-
- # remove everything up to next login or EOF
- while ($line = shift @config) {
- last if ($line =~ /^\[/);
+ if (!$login) {
+ $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|;
+ do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user"));
}
- # this one is either the next login or EOF
- print CONF $line;
-
- while ($line = shift @config) {
- print CONF $line;
- }
-
- print CONF qq|[$self->{login}]\n|;
-
- if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember)
- && $self->{root}) {
- $self->{dbpasswd} = pack 'u', $self->{dbpasswd};
- chop $self->{dbpasswd};
- }
- if (defined($self->{new_password})) {
- if ($self->{new_password} ne $self->{old_password}) {
- $self->{password} = crypt $self->{new_password},
- substr($self->{login}, 0, 2)
- if $self->{new_password};
- }
- } else {
- if ($self->{password} ne $self->{old_password}) {
- $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2)
- if $self->{password};
- }
- }
-
- if ($self->{'root login'}) {
- @config = ("password");
- } else {
- @config = &config_vars;
- }
-
- # replace \r\n with \n
- map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature);
- foreach $key (sort @config) {
- print CONF qq|$key=$self->{$key}\n|;
- }
-
- print CONF "\n";
- close CONF;
- unlink "${memberfile}.LCK";
-
- # create conf file
- $self->create_config("$userspath/$self->{login}.conf")
- unless $self->{'root login'};
-
$main::lxdebug->leave_sub();
}
sub config_vars {
$main::lxdebug->enter_sub();
- my @conf = qw(acs address admin businessnumber charset company countrycode
+ my @conf = qw(acs address admin businessnumber company countrycode
currency dateformat dbconnect dbdriver dbhost dbport dboptions
dbname dbuser dbpasswd email fax name numberformat password
printer role sid signature stylesheet tel templates vclimit angebote
bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen
taxnumber co_ustid duns menustyle template_format default_media
- default_printer_id copies show_form_details);
+ default_printer_id copies show_form_details favorites);
$main::lxdebug->leave_sub();
my ($self, $msg) = @_;
+ $main::lxdebug->show_backtrace();
+
if ($ENV{HTTP_USER_AGENT}) {
print qq|Content-Type: text/html
projects / kivitendo-erp.git / blobdiff