Revision f7057756
Von Moritz Bunkus vor fast 18 Jahren hinzugefügt
| SL/User.pm | ||
|---|---|---|
|
package User;
|
||
|
|
||
|
use SL::DBUpgrade2;
|
||
|
use SL::DBUtils;
|
||
|
|
||
|
sub new {
|
||
|
$main::lxdebug->enter_sub();
|
||
| ... | ... | |
|
my @language = ();
|
||
|
|
||
|
# scan the locale directory and read in the LANGUAGE files
|
||
|
opendir DIR, "locale";
|
||
|
opendir(DIR, "locale");
|
||
|
|
||
|
my @dir = grep !/(^\.\.?$|\..*)/, readdir DIR;
|
||
|
my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
|
||
|
|
||
|
foreach my $dir (@dir) {
|
||
|
next unless open(FH, "locale/$dir/LANGUAGE");
|
||
| ... | ... | |
|
}
|
||
|
|
||
|
do "$userspath/$self->{login}.conf";
|
||
|
$myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd};
|
||
|
$myconfig{dbpasswd} = unpack('u', $myconfig{dbpasswd});
|
||
|
|
||
|
# check if database is down
|
||
|
my $dbh =
|
||
| ... | ... | |
|
|
||
|
# 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 e.id FROM employee e WHERE e.login = '$self->{login}'|;
|
||
|
$sth = $dbh->prepare($query);
|
||
|
$sth->execute;
|
||
|
|
||
|
my ($login) = $sth->fetchrow_array;
|
||
|
$sth->finish;
|
||
|
$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)
|
||
|
VALUES ('$self->{login}', '$myconfig{name}',
|
||
|
'$myconfig{tel}', 'user')|;
|
||
|
$dbh->do($query);
|
||
|
$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_schema_info_table($form, $dbh);
|
||
| ... | ... | |
|
or $form->dberror;
|
||
|
|
||
|
if ($form->{dbdriver} eq 'Pg') {
|
||
|
|
||
|
$query = qq|SELECT datname FROM pg_database WHERE NOT ((datname = 'template0') OR (datname = 'template1'))|;
|
||
|
$sth = $dbh->prepare($query);
|
||
|
$sth->execute || $form->dberror($query);
|
||
|
$query =
|
||
|
qq|SELECT datname FROM pg_database | .
|
||
|
qq|WHERE NOT datname IN ('template0', 'template1')|;
|
||
|
$sth = $dbh->prepare($query);
|
||
|
$sth->execute() || $form->dberror($query);
|
||
|
|
||
|
while (my ($db) = $sth->fetchrow_array) {
|
||
|
|
||
| ... | ... | |
|
DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
|
||
|
or $form->dberror;
|
||
|
|
||
|
$query = qq|SELECT p.tablename FROM pg_tables p
|
||
|
WHERE p.tablename = 'defaults'
|
||
|
AND p.tableowner = '$form->{dbuser}'|;
|
||
|
$query =
|
||
|
qq|SELECT tablename FROM pg_tables | .
|
||
|
qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
|
||
|
my $sth = $dbh->prepare($query);
|
||
|
$sth->execute || $form->dberror($query);
|
||
|
$sth->execute($form->{dbuser}) ||
|
||
|
$form->dberror($query . " ($form->{dbuser})");
|
||
|
|
||
|
if ($sth->fetchrow_array) {
|
||
|
push @dbsources, $db;
|
||
|
push(@dbsources, $db);
|
||
|
}
|
||
|
$sth->finish;
|
||
|
$dbh->disconnect;
|
||
|
next;
|
||
|
}
|
||
|
push @dbsources, $db;
|
||
|
push(@dbsources, $db);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
if ($form->{dbdriver} eq 'Oracle') {
|
||
|
if ($form->{only_acc_db}) {
|
||
|
$query = qq|SELECT o.owner FROM dba_objects o
|
||
|
WHERE o.object_name = 'DEFAULTS'
|
||
|
AND o.object_type = 'TABLE'|;
|
||
|
$query =
|
||
|
qq|SELECT owner FROM dba_objects | .
|
||
|
qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|;
|
||
|
} else {
|
||
|
$query = qq|SELECT username FROM dba_users|;
|
||
|
}
|
||
| ... | ... | |
|
$sth->execute || $form->dberror($query);
|
||
|
|
||
|
while (my ($db) = $sth->fetchrow_array) {
|
||
|
push @dbsources, $db;
|
||
|
push(@dbsources, $db);
|
||
|
}
|
||
|
}
|
||
|
|
||
| ... | ... | |
|
my $dbh =
|
||
|
DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
|
||
|
or $form->dberror;
|
||
|
|
||
|
$form->{db} =~ s/\"//g;
|
||
|
my %dbcreate = (
|
||
|
'Pg' => qq|CREATE DATABASE "$form->{db}"|,
|
||
|
'Oracle' =>
|
||
|
qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
|
||
|
qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS | .
|
||
|
qq|TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"|
|
||
|
);
|
||
|
|
||
|
my %dboptions = (
|
||
| ... | ... | |
|
push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault");
|
||
|
}
|
||
|
|
||
|
my $query = qq|$dbcreate{$form->{dbdriver}}|;
|
||
|
my $query = $dbcreate{$form->{dbdriver}};
|
||
|
$query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}});
|
||
|
|
||
|
$dbh->do($query) || $form->dberror($query);
|
||
|
do_query($form, $dbh, $query);
|
||
|
|
||
|
if ($form->{dbdriver} eq 'Oracle') {
|
||
|
$query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|;
|
||
|
$dbh->do($query) || $form->dberror($query);
|
||
|
$query = qq|GRANT CONNECT, RESOURCE TO "$form->{db}"|;
|
||
|
do_query($form, $dbh, $query);
|
||
|
}
|
||
|
$dbh->disconnect;
|
||
|
|
||
| ... | ... | |
|
$filename = qq|sql/$form->{chart}-chart.sql|;
|
||
|
$self->process_query($form, $dbh, $filename);
|
||
|
|
||
|
$query = "UPDATE defaults SET coa = " . $dbh->quote($form->{"chart"});
|
||
|
$dbh->do($query) || $form->dberror($query);
|
||
|
$query = "UPDATE defaults SET coa = ?";
|
||
|
do_query($form, $dbh, $query, $form->{chart});
|
||
|
|
||
|
$dbh->disconnect;
|
||
|
|
||
| ... | ... | |
|
|
||
|
my ($self, $form, $dbh, $filename, $version_or_control) = @_;
|
||
|
|
||
|
# return unless (-f $filename);
|
||
|
|
||
|
open(FH, "$filename") or $form->error("$filename : $!\n");
|
||
|
my $query = "";
|
||
|
my $sth;
|
||
| ... | ... | |
|
my $errstr = $dbh->errstr;
|
||
|
$sth->finish();
|
||
|
$dbh->rollback();
|
||
|
$form->dberror("The database update/creation did not succeed. The file ${filename} containing the following query failed:<br>${query}<br>" .
|
||
|
$form->dberror("The database update/creation did not succeed. " .
|
||
|
"The file ${filename} containing the following " .
|
||
|
"query failed:<br>${query}<br>" .
|
||
|
"The error message was: ${errstr}<br>" .
|
||
|
"All changes in that file have been reverted.");
|
||
|
}
|
||
| ... | ... | |
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my ($self, $form) = @_;
|
||
|
|
||
|
$form->{db} =~ s/\"//g;
|
||
|
my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|,
|
||
|
'Oracle' => qq|DROP USER $form->{db} CASCADE|);
|
||
|
'Oracle' => qq|DROP USER "$form->{db}" CASCADE|);
|
||
|
|
||
|
$form->{sid} = $form->{dbdefault};
|
||
|
&dbconnect_vars($form, $form->{dbdefault});
|
||
|
my $dbh =
|
||
|
DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
|
||
|
or $form->dberror;
|
||
|
my $query = qq|$dbdelete{$form->{dbdriver}}|;
|
||
|
$dbh->do($query) || $form->dberror($query);
|
||
|
my $query = $dbdelete{$form->{dbdriver}};
|
||
|
do_query($form, $dbh, $query);
|
||
|
|
||
|
$dbh->disconnect;
|
||
|
|
||
| ... | ... | |
|
|
||
|
if ($form->{dbdriver} eq 'Pg') {
|
||
|
|
||
|
$query = qq|SELECT d.datname FROM pg_database d, pg_user u
|
||
|
WHERE d.datdba = u.usesysid
|
||
|
AND u.usename = '$form->{dbuser}'|;
|
||
|
my $sth = $dbh->prepare($query);
|
||
|
$sth->execute || $form->dberror($query);
|
||
|
$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});
|
||
|
|
||
|
while (my ($db) = $sth->fetchrow_array) {
|
||
|
|
||
| ... | ... | |
|
|
||
|
&dbconnect_vars($form, $db);
|
||
|
|
||
|
my $dbh =
|
||
|
my $dbh2 =
|
||
|
DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd})
|
||
|
or $form->dberror;
|
||
|
|
||
|
$query = qq|SELECT t.tablename FROM pg_tables t
|
||
|
WHERE t.tablename = 'defaults'|;
|
||
|
my $sth = $dbh->prepare($query);
|
||
|
$sth->execute || $form->dberror($query);
|
||
|
$query =
|
||
|
qq|SELECT tablename FROM pg_tables | .
|
||
|
qq|WHERE tablename = 'defaults'|;
|
||
|
my $sth2 = prepare_execute_query($form, $dbh, $query);
|
||
|
|
||
|
if ($sth->fetchrow_array) {
|
||
|
if ($sth2->fetchrow_array) {
|
||
|
$query = qq|SELECT version FROM defaults|;
|
||
|
my $sth = $dbh->prepare($query);
|
||
|
$sth->execute;
|
||
|
|
||
|
if (my ($version) = $sth->fetchrow_array) {
|
||
|
$dbsources{$db} = $version;
|
||
|
}
|
||
|
$sth->finish;
|
||
|
my ($version) = selectrow_query($form, $dbh2, $query);
|
||
|
$dbsources{$db} = $version;
|
||
|
}
|
||
|
$sth->finish;
|
||
|
$dbh->disconnect;
|
||
|
$sth2->finish;
|
||
|
$dbh2->disconnect;
|
||
|
}
|
||
|
$sth->finish;
|
||
|
}
|
||
|
|
||
|
if ($form->{dbdriver} eq 'Oracle') {
|
||
|
$query = qq|SELECT o.owner FROM dba_objects o
|
||
|
WHERE o.object_name = 'DEFAULTS'
|
||
|
AND o.object_type = 'TABLE'|;
|
||
|
$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);
|
||
| ... | ... | |
|
return %dbsources;
|
||
|
}
|
||
|
|
||
|
## LINET
|
||
|
sub calc_version {
|
||
|
$main::lxdebug->enter_sub(2);
|
||
|
|
||
| ... | ... | |
|
|
||
|
return $res_a <=> $res_b;
|
||
|
}
|
||
|
## /LINET
|
||
|
|
||
|
sub update_available {
|
||
|
my ($dbdriver, $cur_version) = @_;
|
||
|
|
||
|
opendir SQLDIR, "sql/${dbdriver}-upgrade" or &error("", "sql/${dbdriver}-upgrade: $!");
|
||
|
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;
|
||
|
grep(/$form->{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)) {
|
||
|
$query =
|
||
|
"CREATE TABLE schema_info (" .
|
||
|
" tag text, " .
|
||
|
" login text, " .
|
||
|
" itime timestamp DEFAULT now(), " .
|
||
|
" PRIMARY KEY (tag))";
|
||
|
qq|CREATE TABLE schema_info (| .
|
||
|
qq| tag text, | .
|
||
|
qq| login text, | .
|
||
|
qq| itime timestamp DEFAULT now(), | .
|
||
|
qq| PRIMARY KEY (tag))|;
|
||
|
$dbh->do($query) || $form->dberror($query);
|
||
|
}
|
||
|
|
||
| ... | ... | |
|
if ($form->{dbupdate}) {
|
||
|
|
||
|
# read update scripts into memory
|
||
|
opendir SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade" or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
|
||
|
## LINET
|
||
|
opendir(SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade")
|
||
|
or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!");
|
||
|
@upgradescripts =
|
||
|
sort(cmp_script_version
|
||
|
grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/, readdir(SQLDIR)));
|
||
|
## /LINET
|
||
|
closedir SQLDIR;
|
||
|
grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/,
|
||
|
readdir(SQLDIR)));
|
||
|
closedir(SQLDIR);
|
||
|
}
|
||
|
|
||
|
foreach my $db (split / /, $form->{dbupdate}) {
|
||
|
foreach my $db (split(/ /, $form->{dbupdate})) {
|
||
|
|
||
|
next unless $form->{$db};
|
||
|
|
||
| ... | ... | |
|
|
||
|
# check version
|
||
|
$query = qq|SELECT version FROM defaults|;
|
||
|
my $sth = $dbh->prepare($query);
|
||
|
|
||
|
# no error check, let it fall through
|
||
|
$sth->execute;
|
||
|
|
||
|
my $version = $sth->fetchrow_array;
|
||
|
$sth->finish;
|
||
|
my ($version) = selectrow_query($form, $dbh, $query);
|
||
|
|
||
|
next unless $version;
|
||
|
|
||
|
## LINET
|
||
|
$version = calc_version($version);
|
||
|
## /LINET
|
||
|
|
||
|
foreach my $upgradescript (@upgradescripts) {
|
||
|
my $a = $upgradescript;
|
||
| ... | ... | |
|
|
||
|
my ($mindb, $maxdb) = split /-/, $a;
|
||
|
my $str_maxdb = $maxdb;
|
||
|
## LINET
|
||
|
$mindb = calc_version($mindb);
|
||
|
$maxdb = calc_version($maxdb);
|
||
|
## /LINET
|
||
|
|
||
|
next if ($version >= $maxdb);
|
||
|
|
||
| ... | ... | |
|
# apply upgrade
|
||
|
$main::lxdebug->message(DEBUG2, "Applying Update $upgradescript");
|
||
|
if ($file_type eq "sql") {
|
||
|
$self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb);
|
||
|
$self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
|
||
|
"-upgrade/$upgradescript", $str_maxdb);
|
||
|
} else {
|
||
|
$self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb);
|
||
|
$self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
|
||
|
"-upgrade/$upgradescript", $str_maxdb);
|
||
|
}
|
||
|
|
||
|
$version = $maxdb;
|
||
| ... | ... | |
|
|
||
|
map({ $_->{"applied"} = 0; } @upgradescripts);
|
||
|
|
||
|
$query = "SELECT tag FROM schema_info";
|
||
|
$query = qq|SELECT tag FROM schema_info|;
|
||
|
$sth = $dbh->prepare($query);
|
||
|
$sth->execute() || $form->dberror($query);
|
||
|
while (($tag) = $sth->fetchrow_array()) {
|
||
| ... | ... | |
|
|
||
|
my ($query, $tag, $sth);
|
||
|
|
||
|
$query = "SELECT tag FROM schema_info";
|
||
|
$query = qq|SELECT tag FROM schema_info|;
|
||
|
$sth = $dbh->prepare($query);
|
||
|
$sth->execute() || $form->dberror($query);
|
||
|
while (($tag) = $sth->fetchrow_array()) {
|
||
| ... | ... | |
|
my @conf = qw(acs address admin businessnumber charset 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);
|
||
|
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);
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
Auch abrufbar als: Unified diff
Keine Form-Variablen direkt in SQL-Queries verwenden. Ein paar kosmetische Änderungen wie Zeilenlängen.