package SL::DBUpgrade2;
+use English qw(-no_match_vars);
use IO::File;
use List::MoreUtils qw(any);
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);
+
$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);
}
$dbh->commit();
+ # Clear $::form of values that may have been set so that following
+ # Perl upgrade scripts won't have to work with old data (think of
+ # the usual 'continued' mechanism that's used for determining
+ # whether or not the upgrade form must be displayed).
+ delete @{ $::form }{ keys %{ $::form } };
+ $::form->{$_} = $form_values{$_} for keys %form_values;
+
$::lxdebug->leave_sub();
}
before the current one is applied.
=item charset
+
=item encoding
The charset this file uses. Defaults to C<ISO-8859-15> if