package User;
+use IO::File;
+use Fcntl qw(:seek);
+
use SL::DBUpgrade2;
use SL::DBUtils;
+use SL::Iconv;
+use SL::Inifile;
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";
$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);
}
$self->dbupdate($form);
$self->dbupdate2($form, $controls);
+ close(FH);
+
# remove lock file
unlink("$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) = @_;
- 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();
}
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();
}
my ($self, $form, $memfile) = @_;
+ local *FH;
+
my @dbexcl = ();
my @dbsources = ();
my ($self, $form) = @_;
- my %dbsources = ();
- my $query;
-
- $form->{sid} = $form->{dbdefault};
- &dbconnect_vars($form, $form->{dbdefault});
-
- my $dbh =
- DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
- or $form->dberror;
+ my $members = Inifile->new($main::memberfile);
+ my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
- 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});
+ my ($query, $sth, %dbs_needing_updates);
- while (my ($db) = $sth->fetchrow_array) {
+ foreach my $login (grep /[a-z]/, keys %{ $members }) {
+ my $member = $members->{$login};
- next if ($db =~ /^template/);
+ map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport);
+ dbconnect_vars($form, $form->{dbname});
+ $main::lxdebug->dump(0, "form", $form);
+ 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 ($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};
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};
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();
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 : $!");
+ my $userspath = $main::userspath;
+
+ 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
truncate(CONF, 0);
while ($line = shift @config) {
- if ($line =~ /^\[$self->{login}\]/) {
+ if ($line =~ /^\[\Q$self->{login}\E\]/) {
$newmember = 0;
last;
}
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
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