use IO::File;
use Fcntl qw(:seek);
-use Text::Iconv;
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";
$self->dbupdate($form);
$self->dbupdate2($form, $controls);
+ close(FH);
+
# remove lock file
unlink("$userspath/nologin");
$db_charset ||= Common::DEFAULT_CHARSET;
- my $iconv = Text::Iconv->new($file_charset, $db_charset);
+ my $iconv = SL::Iconv::get_converter($file_charset, $db_charset);
$dbh->begin_work();
$db_charset ||= Common::DEFAULT_CHARSET;
- my $iconv = Text::Iconv->new($file_charset, $db_charset);
-
$dbh->begin_work();
while (<$fh>) {
- $_ = $iconv->convert($_);
+ $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
# Remove DOS and Unix style line endings.
chomp;
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;
-
- if ($form->{dbdriver} eq 'Pg') {
+ my $members = Inifile->new($main::memberfile);
+ my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
- $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 = ();
my $db_charset = $main::dbcharset;
$db_charset ||= Common::DEFAULT_CHARSET;
- my %converters;
-
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"});
- if (!$converters{$control->{charset}}) {
- $converters{$control->{charset}} = Text::Iconv->new($control->{charset}, $db_charset);
- }
- $control->{description} = $converters{$control->{charset}}->convert($control->{description});
+ $control->{description} = SL::Iconv::convert($control->{charset}, $db_charset, $control->{description});
$control->{"file"} =~ /\.(sql|pl)$/;
my $file_type = $1;
$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;
+ my $userspath = $main::userspath;
- 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();
}
my ($self, $msg) = @_;
+ $main::lxdebug->show_backtrace();
+
if ($ENV{HTTP_USER_AGENT}) {
print qq|Content-Type: text/html