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);
|
| sql/Pg-upgrade2/SKR04-3804-addition.pl | ||
|---|---|---|
| 110 | 110 |
$sth_query->finish; |
| 111 | 111 |
$sth_insert->finish; |
| 112 | 112 |
|
| 113 |
return 1; |
|
| 113 | 114 |
} # end run |
| 114 | 115 |
|
| 115 | 116 |
sub print_past_booking_warning {
|
| sql/Pg-upgrade2/USTVA_abstraction.pl | ||
|---|---|---|
| 147 | 147 |
|
| 148 | 148 |
sub run {
|
| 149 | 149 |
my ($self) = @_; |
| 150 |
return $self->create_tables && $self->do_copy; |
|
| 150 |
return $self->create_tables && $self->do_copy ? 1 : undef;
|
|
| 151 | 151 |
} |
| 152 | 152 |
|
| 153 | 153 |
1; |
| sql/Pg-upgrade2/USTVA_at.pl | ||
|---|---|---|
| 36 | 36 |
&& $self->do_insert_tax() |
| 37 | 37 |
&& $self->do_insert_taxkeys() |
| 38 | 38 |
&& $self->do_insert_buchungsgruppen() |
| 39 |
;
|
|
| 39 |
? 1 : 0;
|
|
| 40 | 40 |
} |
| 41 | 41 |
|
| 42 | 42 |
sub clear_tables {
|
| sql/Pg-upgrade2/fix_acc_trans_ap_taxkey_bug.pl | ||
|---|---|---|
| 91 | 91 |
$h_change->finish(); |
| 92 | 92 |
|
| 93 | 93 |
print $::locale->text('Number of entries changed: #1', $num_changed) . "<br/>\n";
|
| 94 |
|
|
| 95 |
return 1; |
|
| 94 | 96 |
} |
| 95 | 97 |
|
| 96 | 98 |
1; |
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).