package User;
+use IO::File;
+use Fcntl qw(:seek);
+
use SL::DBUpgrade2;
use SL::DBUtils;
+use SL::Iconv;
sub new {
$main::lxdebug->enter_sub();
my $self = {};
if ($login ne "") {
+ local *MEMBER;
+
+ $login =~ s|.*/||;
+
&error("", "$memfile locked!") if (-f "${memfile}.LCK");
open(MEMBER, "$memfile") or &error("", "$memfile : $!");
while (<MEMBER>) {
if (/^\[$login\]/) {
while (<MEMBER>) {
- last if /^\[/;
- next if /^(#|\s)/;
+ last if m/^\[/;
+ next if m/^(#|\s)/;
# remove comments
s/\s#.*//g;
sub country_codes {
$main::lxdebug->enter_sub();
+ local *DIR;
+
my %cc = ();
my @language = ();
my ($self, $form, $userspath) = @_;
+ local *FH;
+
my $rc = -3;
if ($self->{login}) {
}
unless (-e "$userspath/$self->{login}.conf") {
- $self->create_config("$userspath/$self->{login}.conf");
+ $self->create_config();
}
do "$userspath/$self->{login}.conf";
$self->dbupdate($form);
$self->dbupdate2($form, $controls);
+ close(FH);
+
# remove lock file
unlink("$userspath/nologin");
$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) = @_;
- open(FH, "$filename") or $form->error("$filename : $!\n");
- my $contents = join("", <FH>);
- close(FH);
+ 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};
+
+ } 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();
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();
}
my ($self, $form, $memfile) = @_;
+ local *FH;
+
my @dbexcl = ();
my @dbsources = ();
sub update_available {
my ($dbdriver, $cur_version) = @_;
+ local *SQLDIR;
+
opendir(SQLDIR, "sql/${dbdriver}-upgrade")
or &error("", "sql/${dbdriver}-upgrade: $!");
my @upgradescripts =
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};
$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};
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;
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);
}
}
sub create_config {
$main::lxdebug->enter_sub();
- my ($self, $filename) = @_;
+ my ($self) = @_;
+
+ local *CONF;
- @config = &config_vars;
+ @config = config_vars();
- open(CONF, ">$filename") or $self->error("$filename : $!");
+ open(CONF, ">", "$userspath/$self->{login}.conf") || $self->error("$userspath/$self->{login}.conf : $!");
# create the config file
print CONF qq|# configuration file for $self->{login}
\%myconfig = (
|;
- foreach $key (sort @config) {
+ foreach my $key (sort @config) {
$self->{$key} =~ s/\'/\\\'/g;
print CONF qq| $key => '$self->{$key}',\n|;
}
my ($self, $memberfile, $userspath) = @_;
+ local (*FH, *CONF);
+
my $newmember = 1;
# format dbconnect and dboptions string
unlink "${memberfile}.LCK";
# create conf file
- $self->create_config("$userspath/$self->{login}.conf")
- unless $self->{'root login'};
+ $self->create_config() 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