X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/61cdba5d566357f3beabe0e7f3f0cb2d7bdccd73..90bb521a25eeb37c5bbae1ff68c38e6c142b6e6b:/SL/DBUpgrade2.pm diff --git a/SL/DBUpgrade2.pm b/SL/DBUpgrade2.pm index 6de1fd258..0daec3606 100644 --- a/SL/DBUpgrade2.pm +++ b/SL/DBUpgrade2.pm @@ -1,5 +1,6 @@ package SL::DBUpgrade2; +use English qw(-no_match_vars); use IO::File; use List::MoreUtils qw(any); @@ -26,7 +27,7 @@ sub init { $params{path_suffix} ||= ''; $params{schema} ||= ''; - $params{path} = "sql/" . $params{dbdriver} . "-upgrade2" . $params{path_suffix}; + $params{path} = "sql/Pg-upgrade2" . $params{path_suffix}; map { $self->{$_} = $params{$_} } keys %params; @@ -242,25 +243,27 @@ sub process_perl_script { my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_; - my %form_values = map { $_ => $::form->{$_} } qw(dbconnect dbdefault dbdriver dbhost dbmbkiviunstable dbname dboptions dbpasswd dbport dbupdate dbuser login template_object version); + my %form_values = map { $_ => $::form->{$_} } qw(dbconnect dbdefault dbhost dbmbkiviunstable dbname dboptions dbpasswd dbport dbupdate dbuser login template_object version); $dbh->begin_work; # setup dbup_ export vars & run script my %dbup_myconfig = map { ($_ => $::form->{$_}) } qw(dbname dbuser dbpasswd dbhost dbport dbconnect); - my $result = SL::DBUpgrade2::Base::execute_script( - file_name => $filename, - tag => $version_or_control->{tag}, - dbh => $dbh, - myconfig => \%dbup_myconfig, - ); + my $result = eval { + SL::DBUpgrade2::Base::execute_script( + file_name => $filename, + tag => $version_or_control->{tag}, + dbh => $dbh, + myconfig => \%dbup_myconfig, + ); + }; - if (1 != ($result // 1)) { - $dbh->rollback(); - } + my $error = $EVAL_ERROR; + + $dbh->rollback if 1 != ($result // -1); if (!defined($result)) { - print $::form->parse_html_template("dbupgrade/error", { file => $filename, error => $@ }); + print $::form->parse_html_template("dbupgrade/error", { file => $filename, error => $error }); ::end_of_request(); } elsif (1 != $result) { unlink("users/nologin") if (2 == $result); @@ -299,9 +302,8 @@ sub update_available { local *SQLDIR; - my $dbdriver = $self->{dbdriver}; - opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!"); - my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR; + opendir SQLDIR, "sql/Pg-upgrade" || error("", "sql/Pg-upgrade: $!"); + my @upgradescripts = grep /Pg-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR; closedir SQLDIR; return ($#upgradescripts > -1); @@ -371,7 +373,7 @@ sub apply_admin_dbupgrade_scripts { $::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}"); print $self->{form}->parse_html_template("dbupgrade/upgrade_message2", $control); - $self->process_file($dbh, "sql/$self->{dbdriver}-upgrade2-auth/$control->{file}", $control, $db_charset); + $self->process_file($dbh, "sql/Pg-upgrade2-auth/$control->{file}", $control, $db_charset); } print $self->{form}->parse_html_template("dbupgrade/footer", { is_admin => 1 }) if $called_from_admin; @@ -458,7 +460,6 @@ C) # Apply outstanding updates to the authentication database my $scripts = SL::DBUpgrade2->new( form => $::form, - dbdriver => 'Pg', auth => 1 ); $scripts->apply_admin_dbupgrade_scripts(1); @@ -466,7 +467,6 @@ C) # Apply updates to a user database my $scripts = SL::DBUpgrade2->new( form => $::form, - dbdriver => $::form->{dbdriver}, auth => 1 ); User->dbupdate2($form, $scripts->parse_dbupdate_controls); @@ -600,11 +600,6 @@ Path to the upgrade files to parse. Required. C object to use. Required. -=item dbdriver - -Name of the database driver. Currently only C for PostgreSQL is -supported. - =item auth Optional parameter defaulting to 0. If trueish then the scripts read