Revision a4665ffc
Von Moritz Bunkus vor mehr als 11 Jahren hinzugefügt
| SL/DBUpgrade2.pm | ||
|---|---|---|
| 1 | 1 |
package SL::DBUpgrade2; |
| 2 | 2 |
|
| 3 |
use English qw(-no_match_vars); |
|
| 3 | 4 |
use IO::File; |
| 4 | 5 |
use List::MoreUtils qw(any); |
| 5 | 6 |
|
| ... | ... | |
| 248 | 249 |
|
| 249 | 250 |
# setup dbup_ export vars & run script |
| 250 | 251 |
my %dbup_myconfig = map { ($_ => $::form->{$_}) } qw(dbname dbuser dbpasswd dbhost dbport dbconnect);
|
| 251 |
my $result = SL::DBUpgrade2::Base::execute_script( |
|
| 252 |
file_name => $filename, |
|
| 253 |
tag => $version_or_control->{tag},
|
|
| 254 |
dbh => $dbh, |
|
| 255 |
myconfig => \%dbup_myconfig, |
|
| 256 |
); |
|
| 252 |
my $result = eval {
|
|
| 253 |
SL::DBUpgrade2::Base::execute_script( |
|
| 254 |
file_name => $filename, |
|
| 255 |
tag => $version_or_control->{tag},
|
|
| 256 |
dbh => $dbh, |
|
| 257 |
myconfig => \%dbup_myconfig, |
|
| 258 |
); |
|
| 259 |
}; |
|
| 257 | 260 |
|
| 258 |
if (1 != ($result // 1)) {
|
|
| 259 |
$dbh->rollback(); |
|
| 260 |
}
|
|
| 261 |
my $error = $EVAL_ERROR;
|
|
| 262 |
|
|
| 263 |
$dbh->rollback if 1 != ($result // -1);
|
|
| 261 | 264 |
|
| 262 | 265 |
if (!defined($result)) {
|
| 263 |
print $::form->parse_html_template("dbupgrade/error", { file => $filename, error => $@ });
|
|
| 266 |
print $::form->parse_html_template("dbupgrade/error", { file => $filename, error => $error });
|
|
| 264 | 267 |
::end_of_request(); |
| 265 | 268 |
} elsif (1 != $result) {
|
| 266 | 269 |
unlink("users/nologin") if (2 == $result);
|
Auch abrufbar als: Unified diff
Perl-Upgrade-Files: Nach Exception Rollback & bei Erfolg immer 1 zurückgeben
Exceptions sind vorher nach oben gebubblet, da $result undef
war. $result // 1 ist nun mal 1, was überhaupt keinen Sinn ergibt --
und dadurch wurde kein Rollback gemacht (geschweige denn die
Fehlermeldung wie gewünscht ausgegeben).
Resultat war bei Perl-DB-Upgrades der Auth-Datenbank, dass trotz
Exception später beim Speichern der Session ein Commit gemacht wurde
-- und damit alle Änderungen vor der Exception mit übernommen
wurden (sofern es da keinen Datenbankfehler gab sonder nur eine von
Perl selber ausgelöste Exception).