Revision 05c6840d
Von Moritz Bunkus vor fast 14 Jahren hinzugefügt
| scripts/dbupgrade2_tool.pl | ||
|---|---|---|
| 10 | 10 |
push @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version. |
| 11 | 11 |
} |
| 12 | 12 |
|
| 13 |
|
|
| 14 |
use strict; |
|
| 15 |
|
|
| 16 |
use utf8; |
|
| 13 | 17 |
use English '-no_match_vars'; |
| 14 | 18 |
|
| 15 | 19 |
use DBI; |
| ... | ... | |
| 19 | 23 |
|
| 20 | 24 |
use SL::LXDebug; |
| 21 | 25 |
|
| 22 |
$lxdebug = LXDebug->new(); |
|
| 26 |
our $lxdebug = LXDebug->new();
|
|
| 23 | 27 |
|
| 24 | 28 |
use SL::Auth; |
| 25 | 29 |
use SL::Form; |
| ... | ... | |
| 37 | 41 |
my ($opt_user, $opt_apply, $opt_applied, $opt_format, $opt_test_utf8); |
| 38 | 42 |
my ($opt_dbhost, $opt_dbport, $opt_dbname, $opt_dbuser, $opt_dbpassword); |
| 39 | 43 |
|
| 40 |
our (%myconfig, $form, $user, $auth); |
|
| 44 |
our (%myconfig, $form, $user, $auth, $locale, $controls);
|
|
| 41 | 45 |
|
| 42 | 46 |
sub show_help {
|
| 43 | 47 |
my $help_text = <<"END_HELP" |
| ... | ... | |
| 109 | 113 |
print "LIST VIEW\n\n" . |
| 110 | 114 |
"number tag depth priority\n"; |
| 111 | 115 |
|
| 112 |
$i = 0; |
|
| 116 |
my $i = 0;
|
|
| 113 | 117 |
foreach (@sorted_controls) {
|
| 114 | 118 |
print "$i $_->{tag} $_->{depth} $_->{priority}\n";
|
| 115 | 119 |
$i++; |
| ... | ... | |
| 178 | 182 |
|
| 179 | 183 |
calc_rev_depends(); |
| 180 | 184 |
|
| 181 |
$dot = "|dot -T${format} ";
|
|
| 185 |
my $dot = "|dot -T${format} ";
|
|
| 182 | 186 |
open OUT, "${dot}> \"${file_name}\"" || die;
|
| 183 | 187 |
|
| 184 | 188 |
print OUT |
| ... | ... | |
| 247 | 251 |
$user->create_schema_info_table($form, $dbh); |
| 248 | 252 |
|
| 249 | 253 |
my $query = qq|SELECT tag FROM schema_info|; |
| 250 |
$sth = $dbh->prepare($query); |
|
| 254 |
my $sth = $dbh->prepare($query);
|
|
| 251 | 255 |
$sth->execute() || $form->dberror($query); |
| 252 |
while (($tag) = $sth->fetchrow_array()) {
|
|
| 256 |
while (my ($tag) = $sth->fetchrow_array()) {
|
|
| 253 | 257 |
$controls->{$tag}->{applied} = 1 if defined $controls->{$tag};
|
| 254 | 258 |
} |
| 255 | 259 |
$sth->finish(); |
| ... | ... | |
| 315 | 319 |
$user->create_schema_info_table($form, $dbh); |
| 316 | 320 |
|
| 317 | 321 |
my $query = qq|SELECT tag, login, itime FROM schema_info ORDER BY itime|; |
| 318 |
$sth = $dbh->prepare($query); |
|
| 322 |
my $sth = $dbh->prepare($query);
|
|
| 319 | 323 |
$sth->execute() || $form->dberror($query); |
| 320 | 324 |
while (my $ref = $sth->fetchrow_hashref()) {
|
| 321 | 325 |
push @results, $ref; |
| ... | ... | |
| 334 | 338 |
sub build_upgrade_order {
|
| 335 | 339 |
my $name = shift; |
| 336 | 340 |
my $order = shift; |
| 337 |
my $tag = shift;
|
|
| 341 |
my $tags = shift;
|
|
| 338 | 342 |
|
| 339 | 343 |
my $control = $controls->{$name};
|
| 340 | 344 |
|
| 341 | 345 |
foreach my $dependency (@{ $control->{depends} }) {
|
| 342 | 346 |
next if $tags->{$dependency};
|
| 343 | 347 |
$tags->{$dependency} = 1;
|
| 344 |
build_upgrade_order($dependency, $order, $tag); |
|
| 348 |
build_upgrade_order($dependency, $order, $tags);
|
|
| 345 | 349 |
} |
| 346 | 350 |
|
| 347 | 351 |
push @{ $order }, $name;
|
| ... | ... | |
| 424 | 428 |
if ($opt_test_utf8) {
|
| 425 | 429 |
$form->error("--test-utf8 used but no database name given with --dbname.") if (!$opt_dbname);
|
| 426 | 430 |
|
| 427 |
my $iconv_to_utf8 = Text::Iconv->new("ISO-8859-15", "UTF-8");
|
|
| 428 |
my $iconv_from_utf8 = Text::Iconv->new("UTF-8", "ISO-8859-15");
|
|
| 429 |
|
|
| 430 |
my $umlaut_upper = '?'; |
|
| 431 |
my $umlaut_upper_utf8 = $iconv_to_utf8->convert($umlaut_upper); |
|
| 431 |
my $umlaut_upper = 'Ä'; |
|
| 432 | 432 |
|
| 433 | 433 |
my $dbconnect = "dbi:Pg:dbname=${opt_dbname}";
|
| 434 | 434 |
$dbconnect .= ";host=${opt_dbhost}" if ($opt_dbhost);
|
| 435 | 435 |
$dbconnect .= ";port=${opt_dbport}" if ($opt_dbport);
|
| 436 | 436 |
|
| 437 |
my $dbh = DBI->connect($dbconnect, $opt_dbuser, $opt_dbpassword); |
|
| 437 |
my $dbh = DBI->connect($dbconnect, $opt_dbuser, $opt_dbpassword, { pg_enable_utf8 => 1 });
|
|
| 438 | 438 |
|
| 439 | 439 |
$form->error("UTF-8 test: Database connect failed (" . $DBI::errstr . ")") if (!$dbh);
|
| 440 | 440 |
|
| 441 |
my ($umlaut_lower_utf8) = $dbh->selectrow_array(qq|SELECT lower(?)|, undef, $umlaut_upper_utf8);
|
|
| 441 |
my ($umlaut_lower) = $dbh->selectrow_array(qq|SELECT lower(?)|, undef, $umlaut_upper);
|
|
| 442 | 442 |
|
| 443 | 443 |
$dbh->disconnect(); |
| 444 | 444 |
|
| 445 |
my $umlaut_lower = $iconv_from_utf8->convert($umlaut_lower_utf8); |
|
| 446 |
|
|
| 447 |
if ($umlaut_lower eq '?') {
|
|
| 445 |
if ($umlaut_lower eq 'ä') {
|
|
| 448 | 446 |
print "UTF-8 test was successful.\n"; |
| 449 |
} elsif ($umlaut_lower eq '?') {
|
|
| 447 |
} elsif ($umlaut_lower eq 'Ä') {
|
|
| 450 | 448 |
print "UTF-8 test was NOT successful: Umlauts are not modified (this might be partially ok, but you should probably not use UTF-8 on this cluster).\n"; |
| 451 | 449 |
} else {
|
| 452 | 450 |
print "UTF-8 test was NOT successful: Umlauts are destroyed. Do not use UTF-8 on this cluster.\n"; |
Auch abrufbar als: Unified diff
Dateiencodings auf UTF-8 geändert
Fix für Bug 1375.