Revision 347f2cff
Von Moritz Bunkus vor mehr als 11 Jahren hinzugefügt
| SL/DBUpgrade2.pm | ||
|---|---|---|
| 4 | 4 |
use List::MoreUtils qw(any); |
| 5 | 5 |
|
| 6 | 6 |
use SL::Common; |
| 7 |
use SL::DBUpgrade2::Base; |
|
| 7 | 8 |
use SL::DBUtils; |
| 8 | 9 |
use SL::Iconv; |
| 9 | 10 |
|
| ... | ... | |
| 79 | 80 |
|
| 80 | 81 |
next if ($control->{ignore});
|
| 81 | 82 |
|
| 83 |
$control->{charset} = 'UTF-8' if $file =~ m/\.pl$/;
|
|
| 82 | 84 |
$control->{charset} = $control->{charset} || $control->{encoding} || Common::DEFAULT_CHARSET;
|
| 83 | 85 |
|
| 84 | 86 |
if (!$control->{"tag"}) {
|
| ... | ... | |
| 240 | 242 |
|
| 241 | 243 |
my ($self, $dbh, $filename, $version_or_control, $db_charset) = @_; |
| 242 | 244 |
|
| 243 |
my $form = $self->{form};
|
|
| 244 |
my $fh = IO::File->new($filename, "r") or $form->error("$filename : $!\n");
|
|
| 245 |
my $file_charset = Common::DEFAULT_CHARSET; |
|
| 246 |
|
|
| 247 |
if (ref($version_or_control) eq "HASH") {
|
|
| 248 |
$file_charset = $version_or_control->{charset};
|
|
| 249 |
|
|
| 250 |
} else {
|
|
| 251 |
while (<$fh>) {
|
|
| 252 |
last if !/^--/; |
|
| 253 |
next if !/^--\s*\@(?:charset|encoding):\s*(.+)/; |
|
| 254 |
$file_charset = $1; |
|
| 255 |
last; |
|
| 256 |
} |
|
| 257 |
$fh->seek(0, SEEK_SET); |
|
| 258 |
} |
|
| 259 |
|
|
| 260 |
my $contents = join "", <$fh>; |
|
| 261 |
$fh->close(); |
|
| 245 |
$dbh->begin_work; |
|
| 262 | 246 |
|
| 263 |
$db_charset ||= Common::DEFAULT_CHARSET; |
|
| 264 |
|
|
| 265 |
my $iconv = SL::Iconv->new($file_charset, $db_charset); |
|
| 266 |
|
|
| 267 |
$dbh->begin_work(); |
|
| 268 |
|
|
| 269 |
# setup dbup_ export vars |
|
| 270 |
my %dbup_myconfig = (); |
|
| 271 |
map({ $dbup_myconfig{$_} = $form->{$_}; } qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
|
|
| 272 |
|
|
| 273 |
my $dbup_locale = $::locale; |
|
| 274 |
|
|
| 275 |
my $result = eval($contents); |
|
| 247 |
# setup dbup_ export vars & run script |
|
| 248 |
my %dbup_myconfig = map { ($_ => $::form->{$_}) } qw(dbname dbuser dbpasswd dbhost dbport dbconnect);
|
|
| 249 |
my $result = SL::DBUpgrade2::Base::execute_script( |
|
| 250 |
file_name => $filename, |
|
| 251 |
tag => $version_or_control->{tag},
|
|
| 252 |
dbh => $dbh, |
|
| 253 |
locale => $::locale, |
|
| 254 |
myconfig => \%dbup_myconfig, |
|
| 255 |
); |
|
| 276 | 256 |
|
| 277 | 257 |
if (1 != $result) {
|
| 278 | 258 |
$dbh->rollback(); |
| ... | ... | |
| 280 | 260 |
} |
| 281 | 261 |
|
| 282 | 262 |
if (!defined($result)) {
|
| 283 |
print $form->parse_html_template("dbupgrade/error",
|
|
| 284 |
{ "file" => $filename,
|
|
| 285 |
"error" => $@ }); |
|
| 263 |
print $::form->parse_html_template("dbupgrade/error", { file => $filename, error => $@ });
|
|
| 286 | 264 |
::end_of_request(); |
| 287 | 265 |
} elsif (1 != $result) {
|
| 288 | 266 |
unlink("users/nologin") if (2 == $result);
|
| ... | ... | |
| 290 | 268 |
} |
| 291 | 269 |
|
| 292 | 270 |
if (ref($version_or_control) eq "HASH") {
|
| 293 |
$dbh->do("INSERT INTO " . $self->{schema} . "schema_info (tag, login) VALUES (" . $dbh->quote($version_or_control->{"tag"}) . ", " . $dbh->quote($form->{"login"}) . ")");
|
|
| 271 |
$dbh->do("INSERT INTO " . $self->{schema} . "schema_info (tag, login) VALUES (" . $dbh->quote($version_or_control->{tag}) . ", " . $dbh->quote($::form->{login}) . ")");
|
|
| 294 | 272 |
} elsif ($version_or_control) {
|
| 295 | 273 |
$dbh->do("UPDATE defaults SET version = " . $dbh->quote($version_or_control));
|
| 296 | 274 |
} |
Auch abrufbar als: Unified diff
Perl-Datenbank-Upgradescripte auf Objektorientierung & strict umgestellt