Projekt

Allgemein

Profil

Herunterladen (16,7 KB) Statistiken
| Zweig: | Markierung: | Revision:

kivitendo/scripts/dbupgrade2_tool.pl @ 71e2b75e

4fd8bdbf Moritz Bunkus
#!/usr/bin/perl

BEGIN {
if (! -d "bin" || ! -d "SL") {
008c2e15 Moritz Bunkus
print("This tool must be run from the kivitendo ERP base directory.\n");
4fd8bdbf Moritz Bunkus
exit(1);
}
3f65b4fb Moritz Bunkus
b179b8df Moritz Bunkus
unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML).
push @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version.
4fd8bdbf Moritz Bunkus
}

05c6840d Moritz Bunkus
use strict;
4c16179d Sven Schöling
use warnings;
05c6840d Moritz Bunkus
use utf8;
a6a8a9a8 Moritz Bunkus
use English '-no_match_vars';

2c1c6a9a Moritz Bunkus
use Config::Std;
4fd8bdbf Moritz Bunkus
use DBI;
use Data::Dumper;
use Getopt::Long;
84c35c85 Moritz Bunkus
use Text::Iconv;
4fd8bdbf Moritz Bunkus
use SL::LXDebug;
67b21d42 Moritz Bunkus
use SL::LxOfficeConf;
4fd8bdbf Moritz Bunkus
67b21d42 Moritz Bunkus
SL::LxOfficeConf->read;
05c6840d Moritz Bunkus
our $lxdebug = LXDebug->new();
4fd8bdbf Moritz Bunkus
0e65146d Moritz Bunkus
use SL::Auth;
4fd8bdbf Moritz Bunkus
use SL::Form;
a6a8a9a8 Moritz Bunkus
use SL::User;
e0cb5a6c Moritz Bunkus
use SL::Locale;
4fd8bdbf Moritz Bunkus
use SL::DBUpgrade2;
a6a8a9a8 Moritz Bunkus
use SL::DBUtils;
5cc5f954 Sven Schöling
use SL::Dispatcher;
4fd8bdbf Moritz Bunkus
#######
#######
#######

a6a8a9a8 Moritz Bunkus
my ($opt_list, $opt_tree, $opt_rtree, $opt_nodeps, $opt_graphviz, $opt_help);
b49ec094 Moritz Bunkus
my ($opt_user, $opt_client, $opt_apply, $opt_applied, $opt_unapplied, $opt_format, $opt_test_utf8);
00cfe3f2 Sven Schöling
my ($opt_dbhost, $opt_dbport, $opt_dbname, $opt_dbuser, $opt_dbpassword, $opt_create, $opt_type);
46dc5b4b Moritz Bunkus
my ($opt_description, $opt_encoding, @opt_depends, $opt_auth_db);
a6a8a9a8 Moritz Bunkus
4c16179d Sven Schöling
our (%myconfig, $form, $user, $auth, $locale, $controls, $dbupgrader);
a6a8a9a8 Moritz Bunkus
46dc5b4b Moritz Bunkus
sub connect_auth {
return $auth if $auth;

$auth = SL::Auth->new;
if (!$auth->session_tables_present) {
$form->error("The session and user management tables are not present in the authentication database. Please use the administration web interface to create them.");
}

return $auth;
}

4fd8bdbf Moritz Bunkus
sub show_help {
2381f1e3 Moritz Bunkus
my $help_text = <<"END_HELP"
92fc1394 Moritz Bunkus
dbupgrade2_tool.pl [options]

A validation and information tool for the database upgrade scripts
2381f1e3 Moritz Bunkus
in \'sql/Pg-upgrade2\'.
92fc1394 Moritz Bunkus
At startup dbupgrade2_tool.pl will always check the consistency
of all database upgrade scripts (e.g. circular references, invalid
2381f1e3 Moritz Bunkus
formats, missing meta information). You can but don\'t have to specifiy
92fc1394 Moritz Bunkus
additional actions.

Actions:
--list Lists all database upgrade tags
--tree Lists all database upgrades in tree form
--rtree Lists all database upgrades in reverse tree form
--graphviz[=file] Create a Postscript document showing a tree of
all database upgrades and their dependencies.
If no file name is given then the output is
2381f1e3 Moritz Bunkus
written to \'db_dependencies.png\'.
--format=... Format for the graphviz output. Defaults to
\'png\'. All values that the command \'dot\' accepts
for it\'s option \'-T\' are acceptable.
487910f2 Moritz Bunkus
--nodeps List all database upgrades that no other upgrade
depends on
1e62938e Sven Schöling
--create=tag Creates a new upgrade with the supplied tag. This
action accepts several optional other options. See
the option section for those. After creating the
upgrade file your \$EDITOR will be called with it.
2381f1e3 Moritz Bunkus
--apply=tag Applies the database upgrades \'tag\' and all
upgrades it depends on. If \'--apply\' is used
then the option \'--user\' must be used as well.
7e96894a Moritz Bunkus
--applied List the applied database upgrades for the
2381f1e3 Moritz Bunkus
database that the user given with \'--user\' uses.
4627ca8b Moritz Bunkus
--unapplied List the database upgrades that haven\'t been applied
yet to the database that the user given with
\'--user\' uses.
84c35c85 Moritz Bunkus
--test-utf8 Tests a PostgreSQL cluster for proper UTF-8 support.
You have to specify the database to test with the
parameters --dbname, --dbhost, --dbport, --dbuser
and --dbpassword.
92fc1394 Moritz Bunkus
--help Show this help and exit.

1e62938e Sven Schöling
General Options:
b49ec094 Moritz Bunkus
--client=id-or-name The name (or database ID) of the client to use for
database connectivity. You must provide both a client
and a user.
92fc1394 Moritz Bunkus
--user=name The name of the user configuration to use for
b49ec094 Moritz Bunkus
database connectivity. You must provide both a client
and a user.
46dc5b4b Moritz Bunkus
--auth-db Work on the authentication database instead of a
user database.
84c35c85 Moritz Bunkus
--dbname=name Database connection options for the UTF-8
--dbhost=host handling test.
--dbport=port
--dbuser=user
--dbpassword=pw

1e62938e Sven Schöling
Options for --create:
--type \'sql\' or \'pl\'. Defaults to sql.
--description The description field of the generated upgrade.
--encoding Encoding used for the file. Defaults to \'utf8\'.
Note: Your editor will not be told to open the file in
this encoding.
--depends Tags of upgrades which this upgrade depends upon.
Defaults to the latest stable release upgrade.
Multiple values possible.

92fc1394 Moritz Bunkus
END_HELP
2381f1e3 Moritz Bunkus
;
487910f2 Moritz Bunkus
92fc1394 Moritz Bunkus
print $help_text;
487910f2 Moritz Bunkus
92fc1394 Moritz Bunkus
exit 0;
a6a8a9a8 Moritz Bunkus
}

sub error {
4fd8bdbf Moritz Bunkus
}

sub calc_rev_depends {
a96f9e80 Moritz Bunkus
map { $_->{rev_depends} = []; } values %{ $controls };

foreach my $control (values %{ $controls }) {
map { push @{ $controls->{$_}->{rev_depends} }, $control->{tag} } @{ $control->{depends} };
4fd8bdbf Moritz Bunkus
}
}

sub dump_list {
4c16179d Sven Schöling
my @sorted_controls = $dbupgrader->sort_dbupdate_controls;
4fd8bdbf Moritz Bunkus
a96f9e80 Moritz Bunkus
print "LIST VIEW\n\n" .
"number tag depth priority\n";

05c6840d Moritz Bunkus
my $i = 0;
4fd8bdbf Moritz Bunkus
foreach (@sorted_controls) {
a96f9e80 Moritz Bunkus
print "$i $_->{tag} $_->{depth} $_->{priority}\n";
4fd8bdbf Moritz Bunkus
$i++;
}

a96f9e80 Moritz Bunkus
print "\n";
4fd8bdbf Moritz Bunkus
}

sub dump_node {
my ($tag, $depth) = @_;

a96f9e80 Moritz Bunkus
print " " x $depth . $tag . "\n";
4fd8bdbf Moritz Bunkus
a96f9e80 Moritz Bunkus
foreach my $dep_tag (@{ $controls->{$tag}->{depends} }) {
dump_node($dep_tag, $depth + 1);
4fd8bdbf Moritz Bunkus
}
}

sub dump_tree {
a96f9e80 Moritz Bunkus
print "TREE VIEW\n\n";
4fd8bdbf Moritz Bunkus
calc_rev_depends();

4c16179d Sven Schöling
my @sorted_controls = $dbupgrader->sort_dbupdate_controls;
4fd8bdbf Moritz Bunkus
foreach my $control (@sorted_controls) {
a96f9e80 Moritz Bunkus
dump_node($control->{tag}, "") unless (@{ $control->{rev_depends} });
4fd8bdbf Moritz Bunkus
}

a96f9e80 Moritz Bunkus
print "\n";
4fd8bdbf Moritz Bunkus
}

sub dump_node_reverse {
my ($tag, $depth) = @_;

a96f9e80 Moritz Bunkus
print " " x $depth . $tag . "\n";
4fd8bdbf Moritz Bunkus
a96f9e80 Moritz Bunkus
foreach my $dep_tag (@{ $controls->{$tag}->{rev_depends} }) {
dump_node_reverse($dep_tag, $depth + 1);
4fd8bdbf Moritz Bunkus
}
}

sub dump_tree_reverse {
a96f9e80 Moritz Bunkus
print "REVERSE TREE VIEW\n\n";
4fd8bdbf Moritz Bunkus
calc_rev_depends();

4c16179d Sven Schöling
my @sorted_controls = $dbupgrader->sort_dbupdate_controls;
4fd8bdbf Moritz Bunkus
foreach my $control (@sorted_controls) {
a96f9e80 Moritz Bunkus
last if ($control->{depth} > 1);
dump_node_reverse($control->{tag}, "");
4fd8bdbf Moritz Bunkus
}

a96f9e80 Moritz Bunkus
print "\n";
4fd8bdbf Moritz Bunkus
}

sub dump_graphviz {
2381f1e3 Moritz Bunkus
my %params = @_;

my $format = $params{format} || "png";
my $file_name = $params{file_name} || "db_dependencies.${format}";
92fc1394 Moritz Bunkus
2381f1e3 Moritz Bunkus
print "GRAPHVIZ OUTPUT -- format: ${format}\n\n";
a96f9e80 Moritz Bunkus
print "Output will be written to '${file_name}'\n";
0c128c20 Moritz Bunkus
calc_rev_depends();

05c6840d Moritz Bunkus
my $dot = "|dot -T${format} ";
0c128c20 Moritz Bunkus
open OUT, "${dot}> \"${file_name}\"" || die;

a96f9e80 Moritz Bunkus
print OUT
"digraph db_dependencies {\n" .
fdec9e46 Moritz Bunkus
"graph [size=\"16.53,11.69!\"];\n" .
a96f9e80 Moritz Bunkus
"node [shape=box style=filled fillcolor=white];\n";

4fd8bdbf Moritz Bunkus
my %ranks;
a96f9e80 Moritz Bunkus
foreach my $c (values %{ $controls }) {
$ranks{$c->{depth}} ||= [];
0c128c20 Moritz Bunkus
4c16179d Sven Schöling
my ($pre, $post) = @{ $c->{rev_depends} } ? ('')x2 :
(map "node [fillcolor=$_] ", qw(lightgray white));
0c128c20 Moritz Bunkus
push @{ $ranks{$c->{"depth"}} }, qq|${pre}"$c->{tag}"; ${post}|;
4fd8bdbf Moritz Bunkus
}
a96f9e80 Moritz Bunkus
foreach (sort keys %ranks) {
0c128c20 Moritz Bunkus
print OUT "{ rank = same; ", join("", @{ $ranks{$_} }), " }\n";
4fd8bdbf Moritz Bunkus
}
a96f9e80 Moritz Bunkus
foreach my $c (values %{ $controls }) {
4c16179d Sven Schöling
print OUT qq|"$c->{tag}";\n|;
a96f9e80 Moritz Bunkus
foreach my $d (@{ $c->{depends} }) {
4c16179d Sven Schöling
print OUT qq|"$c->{tag}" -> "$d";\n|;
4fd8bdbf Moritz Bunkus
}
}
a96f9e80 Moritz Bunkus
print OUT "}\n";
close OUT;
4fd8bdbf Moritz Bunkus
}

sub dump_nodeps {
calc_rev_depends();

a96f9e80 Moritz Bunkus
print "SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" .
join("\n", map { $_->{tag} } grep { !scalar @{ $_->{rev_depends} } } values %{ $controls }) .
"\n\n";
4fd8bdbf Moritz Bunkus
}

00cfe3f2 Sven Schöling
sub create_upgrade {
my (%params) = @_;

my $filename = $params{filename};
my $dbupgrader = $params{dbupgrader};
1e62938e Sven Schöling
my $type = $params{type} || 'sql';
00cfe3f2 Sven Schöling
my $description = $params{description} || '';
my $encoding = $params{encoding} || 'utf-8';
my @depends = @{ $params{depends} };

if (!@depends) {
my @releases = grep { /^release_/ } keys %$controls;
@depends = ((sort @releases)[-1]);
}

my $comment;
if ($type eq 'sql') {
$comment = '--';
} elsif ($type eq 'pl') {
$comment = '#';
} elsif (!$type) {
die 'Error: No --type was given but is required for --create.';
} else {
die 'Error: Unknown --type. Try "sql" or "pl".';
}

my $full_filename = $dbupgrader->path . '/' . $filename . '.' . $type;

die "file '$full_filename' already exists, aborting" if -f $full_filename;


30e67fae Sven Schöling
open my $fh, ">:encoding($encoding)", $full_filename or die "can't open $full_filename";
00cfe3f2 Sven Schöling
print $fh "$comment \@tag: $filename\n";
print $fh "$comment \@description: $description\n";
print $fh "$comment \@depends: @depends\n";
print $fh "$comment \@encoding: $encoding\n";
close $fh;

1e62938e Sven Schöling
print "File $full_filename created.\n";

00cfe3f2 Sven Schöling
system("\$EDITOR $full_filename");
exit 0;
}

a6a8a9a8 Moritz Bunkus
sub apply_upgrade {
my $name = shift;

acd67df0 Moritz Bunkus
my (@order, %tags, @all_tags);
a6a8a9a8 Moritz Bunkus
acd67df0 Moritz Bunkus
if ($name eq "ALL") {
calc_rev_depends();
a96f9e80 Moritz Bunkus
@all_tags = map { $_->{tag} } grep { !@{$_->{rev_depends}} } values %{ $controls };
a6a8a9a8 Moritz Bunkus
acd67df0 Moritz Bunkus
} else {
$form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name});
@all_tags = ($name);
}

foreach my $tag (@all_tags) {
build_upgrade_order($tag, \@order, \%tags);
}
a6a8a9a8 Moritz Bunkus
a96f9e80 Moritz Bunkus
my @upgradescripts = map { $controls->{$_}->{applied} = 0; $controls->{$_} } @order;
a6a8a9a8 Moritz Bunkus
46dc5b4b Moritz Bunkus
my $dbh = $opt_auth_db ? connect_auth()->dbconnect : $form->dbconnect_noauto(\%myconfig);
$dbh->{AutoCommit} = 0;
a6a8a9a8 Moritz Bunkus
$dbh->{PrintWarn} = 0;
$dbh->{PrintError} = 0;

$user->create_schema_info_table($form, $dbh);

my $query = qq|SELECT tag FROM schema_info|;
05c6840d Moritz Bunkus
my $sth = $dbh->prepare($query);
a6a8a9a8 Moritz Bunkus
$sth->execute() || $form->dberror($query);
05c6840d Moritz Bunkus
while (my ($tag) = $sth->fetchrow_array()) {
a96f9e80 Moritz Bunkus
$controls->{$tag}->{applied} = 1 if defined $controls->{$tag};
a6a8a9a8 Moritz Bunkus
}
$sth->finish();

a96f9e80 Moritz Bunkus
@upgradescripts = sort { $a->{priority} <=> $b->{priority} } grep { !$_->{applied} } @upgradescripts;
acd67df0 Moritz Bunkus
if (!@upgradescripts) {
a6a8a9a8 Moritz Bunkus
print "The upgrade has already been applied.\n";
exit 0;
}

foreach my $control (@upgradescripts) {
a96f9e80 Moritz Bunkus
$control->{file} =~ /\.(sql|pl)$/;
a6a8a9a8 Moritz Bunkus
my $file_type = $1;

# apply upgrade
print "Applying upgrade $control->{file}\n";

if ($file_type eq "sql") {
dbda14c2 Moritz Bunkus
$dbupgrader->process_query($dbh, "sql/Pg-upgrade2/$control->{file}", $control);
a6a8a9a8 Moritz Bunkus
} else {
dbda14c2 Moritz Bunkus
$dbupgrader->process_perl_script($dbh, "sql/Pg-upgrade2/$control->{file}", $control);
a6a8a9a8 Moritz Bunkus
}
}

46dc5b4b Moritz Bunkus
$dbh->disconnect unless $opt_auth_db;
a6a8a9a8 Moritz Bunkus
}

7e96894a Moritz Bunkus
sub dump_sql_result {
my ($results, $column_order) = @_;

my %column_lengths = map { $_, length $_ } keys %{ $results->[0] };

foreach my $row (@{ $results }) {
map { $column_lengths{$_} = length $row->{$_} if (length $row->{$_} > $column_lengths{$_}) } keys %{ $row };
}

my @sorted_names;
if ($column_order && scalar @{ $column_order }) {
@sorted_names = @{ $column_order };
} else {
@sorted_names = sort keys %column_lengths;
}

my $format = join('|', map { '%-' . $column_lengths{$_} . 's' } @sorted_names) . "\n";

printf $format, @sorted_names;
print join('+', map { '-' x $column_lengths{$_} } @sorted_names) . "\n";

foreach my $row (@{ $results }) {
printf $format, map { $row->{$_} } @sorted_names;
}
printf "(\%d row\%s)\n", scalar @{ $results }, scalar @{ $results } > 1 ? 's' : '';
}

sub dump_applied {
my @results;

46dc5b4b Moritz Bunkus
my $dbh = $opt_auth_db ? connect_auth()->dbconnect : $form->dbconnect_noauto(\%myconfig);
$dbh->{AutoCommit} = 0;
7e96894a Moritz Bunkus
$dbh->{PrintWarn} = 0;
$dbh->{PrintError} = 0;

$user->create_schema_info_table($form, $dbh);

my $query = qq|SELECT tag, login, itime FROM schema_info ORDER BY itime|;
05c6840d Moritz Bunkus
my $sth = $dbh->prepare($query);
7e96894a Moritz Bunkus
$sth->execute() || $form->dberror($query);
while (my $ref = $sth->fetchrow_hashref()) {
push @results, $ref;
}
$sth->finish();

46dc5b4b Moritz Bunkus
$dbh->disconnect unless $opt_auth_db;
7e96894a Moritz Bunkus
if (!scalar @results) {
print "No database upgrades have been applied yet.\n";
} else {
dump_sql_result(\@results, [qw(tag login itime)]);
}
}

4627ca8b Moritz Bunkus
sub dump_unapplied {
my @results;

46dc5b4b Moritz Bunkus
my $dbh = $opt_auth_db ? connect_auth()->dbconnect : $form->dbconnect_noauto(\%myconfig);
4627ca8b Moritz Bunkus
$dbh->{PrintWarn} = 0;
$dbh->{PrintError} = 0;

my @unapplied = $dbupgrader->unapplied_upgrade_scripts($dbh);

46dc5b4b Moritz Bunkus
$dbh->disconnect unless $opt_auth_db;
4627ca8b Moritz Bunkus
if (!scalar @unapplied) {
print "All database upgrades have been applied.\n";
} else {
print map { $_->{tag} . "\n" } @unapplied;
}
}

a6a8a9a8 Moritz Bunkus
sub build_upgrade_order {
my $name = shift;
my $order = shift;
05c6840d Moritz Bunkus
my $tags = shift;
a6a8a9a8 Moritz Bunkus
my $control = $controls->{$name};

a96f9e80 Moritz Bunkus
foreach my $dependency (@{ $control->{depends} }) {
a6a8a9a8 Moritz Bunkus
next if $tags->{$dependency};
$tags->{$dependency} = 1;
05c6840d Moritz Bunkus
build_upgrade_order($dependency, $order, $tags);
a6a8a9a8 Moritz Bunkus
}

push @{ $order }, $name;
acd67df0 Moritz Bunkus
$tags->{$name} = 1;
a6a8a9a8 Moritz Bunkus
}

4fd8bdbf Moritz Bunkus
#######
#######
#######

3a94f4d2 Moritz Bunkus
$locale = Locale->new;
$form = Form->new;
4fd8bdbf Moritz Bunkus
#######
#######
#######

84c35c85 Moritz Bunkus
GetOptions("list" => \$opt_list,
"tree" => \$opt_tree,
"rtree" => \$opt_rtree,
"nodeps" => \$opt_nodeps,
"graphviz:s" => \$opt_graphviz,
"format:s" => \$opt_format,
"user=s" => \$opt_user,
b49ec094 Moritz Bunkus
"client=s" => \$opt_client,
84c35c85 Moritz Bunkus
"apply=s" => \$opt_apply,
"applied" => \$opt_applied,
00cfe3f2 Sven Schöling
"create=s" => \$opt_create,
"type=s" => \$opt_type,
"encoding=s" => \$opt_encoding,
"description=s" => \$opt_description,
"depends=s" => \@opt_depends,
4627ca8b Moritz Bunkus
"unapplied" => \$opt_unapplied,
84c35c85 Moritz Bunkus
"test-utf8" => \$opt_test_utf8,
"dbhost:s" => \$opt_dbhost,
"dbport:s" => \$opt_dbport,
"dbname:s" => \$opt_dbname,
"dbuser:s" => \$opt_dbuser,
"dbpassword:s" => \$opt_dbpassword,
46dc5b4b Moritz Bunkus
"auth-db" => \$opt_auth_db,
84c35c85 Moritz Bunkus
"help" => \$opt_help,
4fd8bdbf Moritz Bunkus
);

a96f9e80 Moritz Bunkus
show_help() if ($opt_help);
4fd8bdbf Moritz Bunkus
90bb521a Moritz Bunkus
$dbupgrader = SL::DBUpgrade2->new(form => $form, auth => $opt_auth_db);
4c16179d Sven Schöling
$controls = $dbupgrader->parse_dbupdate_controls->{all_controls};
4fd8bdbf Moritz Bunkus
2381f1e3 Moritz Bunkus
dump_list() if ($opt_list);
dump_tree() if ($opt_tree);
dump_tree_reverse() if ($opt_rtree);
dump_graphviz('file_name' => $opt_graphviz,
'format' => $opt_format) if (defined $opt_graphviz);
dump_nodeps() if ($opt_nodeps);
00cfe3f2 Sven Schöling
create_upgrade(filename => $opt_create,
dbupgrader => $dbupgrader,
type => $opt_type,
description => $opt_description,
encoding => $opt_encoding,
depends => \@opt_depends) if ($opt_create);
a6a8a9a8 Moritz Bunkus
b49ec094 Moritz Bunkus
if ($opt_client && !connect_auth()->set_client($opt_client)) {
$form->error($form->format_string("The client '#1' does not exist.", $opt_client));
}

a6a8a9a8 Moritz Bunkus
if ($opt_user) {
b49ec094 Moritz Bunkus
$form->error("Need a client, too.") if !$auth || !$auth->client;

46dc5b4b Moritz Bunkus
%myconfig = connect_auth()->read_user(login => $opt_user);
0e65146d Moritz Bunkus
if (!$myconfig{login}) {
$form->error($form->format_string("The user '#1' does not exist.", $opt_user));
}
a6a8a9a8 Moritz Bunkus
$locale = new Locale($myconfig{countrycode}, "all");
062940d9 Sven Schöling
$user = new User(login => $opt_user);
0e65146d Moritz Bunkus
a6a8a9a8 Moritz Bunkus
map { $form->{$_} = $myconfig{$_} } keys %myconfig;
}

if ($opt_apply) {
46dc5b4b Moritz Bunkus
$form->error("--apply used but no user name given with --user.") if !$user && !$opt_auth_db;
a6a8a9a8 Moritz Bunkus
apply_upgrade($opt_apply);
}
7e96894a Moritz Bunkus
if ($opt_applied) {
46dc5b4b Moritz Bunkus
$form->error("--applied used but no user name given with --user.") if !$user && !$opt_auth_db;
7e96894a Moritz Bunkus
dump_applied();
}
84c35c85 Moritz Bunkus
4627ca8b Moritz Bunkus
if ($opt_unapplied) {
46dc5b4b Moritz Bunkus
$form->error("--unapplied used but no user name given with --user.") if !$user && !$opt_auth_db;
4627ca8b Moritz Bunkus
dump_unapplied();
}

00cfe3f2 Sven Schöling
84c35c85 Moritz Bunkus
if ($opt_test_utf8) {
$form->error("--test-utf8 used but no database name given with --dbname.") if (!$opt_dbname);

05c6840d Moritz Bunkus
my $umlaut_upper = 'Ä';
84c35c85 Moritz Bunkus
my $dbconnect = "dbi:Pg:dbname=${opt_dbname}";
$dbconnect .= ";host=${opt_dbhost}" if ($opt_dbhost);
$dbconnect .= ";port=${opt_dbport}" if ($opt_dbport);

05c6840d Moritz Bunkus
my $dbh = DBI->connect($dbconnect, $opt_dbuser, $opt_dbpassword, { pg_enable_utf8 => 1 });
84c35c85 Moritz Bunkus
$form->error("UTF-8 test: Database connect failed (" . $DBI::errstr . ")") if (!$dbh);

05c6840d Moritz Bunkus
my ($umlaut_lower) = $dbh->selectrow_array(qq|SELECT lower(?)|, undef, $umlaut_upper);
84c35c85 Moritz Bunkus
$dbh->disconnect();

05c6840d Moritz Bunkus
if ($umlaut_lower eq 'ä') {
84c35c85 Moritz Bunkus
print "UTF-8 test was successful.\n";
05c6840d Moritz Bunkus
} elsif ($umlaut_lower eq 'Ä') {
84c35c85 Moritz Bunkus
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";
} else {
print "UTF-8 test was NOT successful: Umlauts are destroyed. Do not use UTF-8 on this cluster.\n";
}
}