X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/57463eed482c9f107a6bb35d8b24d666175570a3..8b39e3893d7e9061c0e8142aca681c90f137bf30:/SL/User.pm
diff --git a/SL/User.pm b/SL/User.pm
index b1a904afd..838b6a696 100644
--- a/SL/User.pm
+++ b/SL/User.pm
@@ -125,8 +125,8 @@ sub login {
$rc = 0;
- my $controls =
- parse_dbupdate_controls($form, $myconfig{"dbdriver"});
+ my $dbupdater = SL::DBUpgrade2->new($form, $myconfig{"dbdriver"});
+ my $controls = $dbupdater->parse_dbupdate_controls;
map({ $form->{$_} = $myconfig{$_} }
qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat));
@@ -163,7 +163,7 @@ sub login {
$SIG{QUIT} = 'IGNORE';
$self->dbupdate($form);
- $self->dbupdate2($form, $controls);
+ $self->dbupdate2($form, $dbupdater);
close(FH);
@@ -395,11 +395,12 @@ sub dbcreate {
my $db_charset = $Common::db_encoding_to_charset{$form->{encoding}};
$db_charset ||= Common::DEFAULT_CHARSET;
+ my $dbupdater = SL::DBUpgrade2->new($form, $form->{dbdriver});
# create the tables
- $self->process_query($form, $dbh, "sql/lx-office.sql", undef, $db_charset);
+ $dbupdater->process_query($dbh, "sql/lx-office.sql", undef, $db_charset);
# load chart of accounts
- $self->process_query($form, $dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
+ $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql", undef, $db_charset);
$query = "UPDATE defaults SET coa = ?";
do_query($form, $dbh, $query, $form->{chart});
@@ -409,172 +410,6 @@ sub dbcreate {
$main::lxdebug->leave_sub();
}
-# Process a Perl script which updates the database.
-# If the script returns 1 then the update was successful.
-# Return code "2" means "needs more interaction; remove
-# users/nologin and end current request".
-# All other return codes are fatal errors.
-sub process_perl_script {
- $main::lxdebug->enter_sub();
-
- 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};
-
- } 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();
-
- # setup dbup_ export vars
- my %dbup_myconfig = ();
- map({ $dbup_myconfig{$_} = $form->{$_}; }
- qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
-
- my $dbup_locale = $::locale;
-
- my $result = eval($contents);
-
- if (1 != $result) {
- $dbh->rollback();
- $dbh->disconnect();
- }
-
- if (!defined($result)) {
- print $form->parse_html_template("dbupgrade/error",
- { "file" => $filename,
- "error" => $@ });
- ::end_of_request();
- } elsif (1 != $result) {
- unlink("users/nologin") if (2 == $result);
- ::end_of_request();
- }
-
- if (ref($version_or_control) eq "HASH") {
- $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
- $dbh->quote($version_or_control->{"tag"}) . ", " .
- $dbh->quote($form->{"login"}) . ")");
- } elsif ($version_or_control) {
- $dbh->do("UPDATE defaults SET version = " .
- $dbh->quote($version_or_control));
- }
- $dbh->commit();
-
- $main::lxdebug->leave_sub();
-}
-
-sub process_query {
- $main::lxdebug->enter_sub();
-
- my ($self, $form, $dbh, $filename, $version_or_control, $db_charset) = @_;
-
- 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>) {
- $_ = SL::Iconv::convert($file_charset, $db_charset, $_);
-
- # Remove DOS and Unix style line endings.
- chomp;
-
- # remove comments
- s/--.*$//;
-
- for (my $i = 0; $i < length($_); $i++) {
- my $char = substr($_, $i, 1);
-
- # Are we inside a string?
- if (@quote_chars) {
- if ($char eq $quote_chars[-1]) {
- pop(@quote_chars);
- }
- $query .= $char;
-
- } else {
- if (($char eq "'") || ($char eq "\"")) {
- push(@quote_chars, $char);
-
- } elsif ($char eq ";") {
-
- # Query is complete. Send it.
-
- $sth = $dbh->prepare($query);
- if (!$sth->execute()) {
- 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:
${query}
" .
- "The error message was: ${errstr}
" .
- "All changes in that file have been reverted.");
- }
- $sth->finish();
-
- $char = "";
- $query = "";
- }
-
- $query .= $char;
- }
- }
-
- # Insert a space at the end of each line so that queries split
- # over multiple lines work properly.
- if ($query ne '') {
- $query .= @quote_chars ? "\n" : ' ';
- }
- }
-
- if (ref($version_or_control) eq "HASH") {
- $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" .
- $dbh->quote($version_or_control->{"tag"}) . ", " .
- $dbh->quote($form->{"login"}) . ")");
- } elsif ($version_or_control) {
- $dbh->do("UPDATE defaults SET version = " .
- $dbh->quote($version_or_control));
- }
- $dbh->commit();
-
- $fh->close();
-
- $main::lxdebug->leave_sub();
-}
-
sub dbdelete {
$main::lxdebug->enter_sub();
@@ -622,7 +457,7 @@ sub dbneedsupdate {
my ($self, $form) = @_;
my %members = $main::auth->read_all_users();
- my $controls = parse_dbupdate_controls($form, $form->{dbdriver});
+ my $controls = SL::DBUpgrade2->new($form, $form->{dbdriver})->parse_dbupdate_controls;
my ($query, $sth, %dbs_needing_updates);
@@ -762,6 +597,8 @@ sub dbupdate {
my $db_charset = $main::dbcharset;
$db_charset ||= Common::DEFAULT_CHARSET;
+ my $dbupdater = SL::DBUpgrade2->new($form, $form->{dbdriver});
+
foreach my $db (split(/ /, $form->{dbupdate})) {
next unless $form->{$db};
@@ -802,11 +639,9 @@ sub dbupdate {
# apply upgrade
$main::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $upgradescript");
if ($file_type eq "sql") {
- $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} .
- "-upgrade/$upgradescript", $str_maxdb, $db_charset);
+ $dbupdater->process_query($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
} else {
- $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
- "-upgrade/$upgradescript", $str_maxdb, $db_charset);
+ $dbupdater->process_perl_script($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb, $db_charset);
}
$version = $maxdb;
@@ -826,7 +661,7 @@ sub dbupdate {
sub dbupdate2 {
$main::lxdebug->enter_sub();
- my ($self, $form, $controls) = @_;
+ my ($self, $form, $dbupdater) = @_;
$form->{sid} = $form->{dbdefault};
@@ -834,7 +669,7 @@ sub dbupdate2 {
my ($query, $sth, $tag);
my $rc = -2;
- @upgradescripts = sort_dbupdate_controls($controls);
+ @upgradescripts = $dbupdater->sort_dbupdate_controls;
my $db_charset = $main::dbcharset;
$db_charset ||= Common::DEFAULT_CHARSET;
@@ -861,7 +696,7 @@ sub dbupdate2 {
$sth = $dbh->prepare($query);
$sth->execute() || $form->dberror($query);
while (($tag) = $sth->fetchrow_array()) {
- $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag}));
+ $dbupdater->{all_controls}->{$tag}->{"applied"} = 1 if (defined($dbupdater->{all_controls}->{$tag}));
}
$sth->finish();
@@ -888,11 +723,9 @@ sub dbupdate2 {
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, $db_charset);
+ $dbupdater->process_query($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
} else {
- $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} .
- "-upgrade2/$control->{file}", $control, $db_charset);
+ $dbupdater->process_perl_script($dbh, "sql/" . $form->{"dbdriver"} . "-upgrade2/$control->{file}", $control, $db_charset);
}
}