X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=scripts%2Fdbupgrade2_tool.pl;h=deee26409fbb78609aca9b7740006c5345ce28ca;hb=7b9d1666e389bfedba43b2d0fd5d1b0e3f129e88;hp=e290adefac30d67a6e76f07a4d576aec2c1aa48c;hpb=2381f1e308db61970b8ab3bb760bd3854cdcbb18;p=kivitendo-erp.git diff --git a/scripts/dbupgrade2_tool.pl b/scripts/dbupgrade2_tool.pl index e290adefa..deee26409 100755 --- a/scripts/dbupgrade2_tool.pl +++ b/scripts/dbupgrade2_tool.pl @@ -10,15 +10,24 @@ BEGIN { push @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version. } + +use strict; +use warnings; + +use utf8; use English '-no_match_vars'; +use Config::Std; use DBI; use Data::Dumper; use Getopt::Long; +use Text::Iconv; use SL::LXDebug; +use SL::LxOfficeConf; -$lxdebug = LXDebug->new(); +SL::LxOfficeConf->read; +our $lxdebug = LXDebug->new(); use SL::Auth; use SL::Form; @@ -26,15 +35,17 @@ use SL::User; use SL::Locale; use SL::DBUpgrade2; use SL::DBUtils; +use SL::Dispatcher; ####### ####### ####### my ($opt_list, $opt_tree, $opt_rtree, $opt_nodeps, $opt_graphviz, $opt_help); -my ($opt_user, $opt_apply, $opt_applied, $opt_format); +my ($opt_user, $opt_apply, $opt_applied, $opt_unapplied, $opt_format, $opt_test_utf8); +my ($opt_dbhost, $opt_dbport, $opt_dbname, $opt_dbuser, $opt_dbpassword); -our (%myconfig, $form, $user, $auth); +our (%myconfig, $form, $user, $auth, $locale, $controls, $dbupgrader); sub show_help { my $help_text = <<"END_HELP" @@ -66,11 +77,24 @@ dbupgrade2_tool.pl [options] then the option \'--user\' must be used as well. --applied List the applied database upgrades for the database that the user given with \'--user\' uses. + --unapplied List the database upgrades that haven\'t been applied + yet to the database that the user given with + \'--user\' uses. + --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. --help Show this help and exit. Options: --user=name The name of the user configuration to use for database connectivity. + --dbname=name Database connection options for the UTF-8 + --dbhost=host handling test. + --dbport=port + --dbuser=user + --dbpassword=pw + END_HELP ; @@ -91,12 +115,12 @@ sub calc_rev_depends { } sub dump_list { - my @sorted_controls = sort_dbupdate_controls($controls); + my @sorted_controls = $dbupgrader->sort_dbupdate_controls; print "LIST VIEW\n\n" . "number tag depth priority\n"; - $i = 0; + my $i = 0; foreach (@sorted_controls) { print "$i $_->{tag} $_->{depth} $_->{priority}\n"; $i++; @@ -120,7 +144,7 @@ sub dump_tree { calc_rev_depends(); - my @sorted_controls = sort_dbupdate_controls($controls); + my @sorted_controls = $dbupgrader->sort_dbupdate_controls; foreach my $control (@sorted_controls) { dump_node($control->{tag}, "") unless (@{ $control->{rev_depends} }); @@ -144,7 +168,7 @@ sub dump_tree_reverse { calc_rev_depends(); - my @sorted_controls = sort_dbupdate_controls($controls); + my @sorted_controls = $dbupgrader->sort_dbupdate_controls; foreach my $control (@sorted_controls) { last if ($control->{depth} > 1); @@ -165,7 +189,7 @@ sub dump_graphviz { calc_rev_depends(); - $dot = "|dot -T${format} "; + my $dot = "|dot -T${format} "; open OUT, "${dot}> \"${file_name}\"" || die; print OUT @@ -177,7 +201,8 @@ sub dump_graphviz { foreach my $c (values %{ $controls }) { $ranks{$c->{depth}} ||= []; - my ($pre, $post) = ('node [fillcolor=lightgray] ', 'node [fillcolor=white] ') if (!scalar @{ $c->{rev_depends} }); + my ($pre, $post) = @{ $c->{rev_depends} } ? ('')x2 : + (map "node [fillcolor=$_] ", qw(lightgray white)); push @{ $ranks{$c->{"depth"}} }, qq|${pre}"$c->{tag}"; ${post}|; } @@ -187,10 +212,10 @@ sub dump_graphviz { } foreach my $c (values %{ $controls }) { - print OUT "$c->{tag};\n"; + print OUT qq|"$c->{tag}";\n|; foreach my $d (@{ $c->{depends} }) { - print OUT "$c->{tag} -> $d;\n"; + print OUT qq|"$c->{tag}" -> "$d";\n|; } } @@ -234,9 +259,9 @@ sub apply_upgrade { $user->create_schema_info_table($form, $dbh); my $query = qq|SELECT tag FROM schema_info|; - $sth = $dbh->prepare($query); + my $sth = $dbh->prepare($query); $sth->execute() || $form->dberror($query); - while (($tag) = $sth->fetchrow_array()) { + while (my ($tag) = $sth->fetchrow_array()) { $controls->{$tag}->{applied} = 1 if defined $controls->{$tag}; } $sth->finish(); @@ -255,9 +280,9 @@ sub apply_upgrade { print "Applying upgrade $control->{file}\n"; if ($file_type eq "sql") { - $user->process_query($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control); + $dbupgrader->process_query($dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control); } else { - $user->process_perl_script($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control); + $dbupgrader->process_perl_script($dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control); } } @@ -302,7 +327,7 @@ sub dump_applied { $user->create_schema_info_table($form, $dbh); my $query = qq|SELECT tag, login, itime FROM schema_info ORDER BY itime|; - $sth = $dbh->prepare($query); + my $sth = $dbh->prepare($query); $sth->execute() || $form->dberror($query); while (my $ref = $sth->fetchrow_hashref()) { push @results, $ref; @@ -318,17 +343,36 @@ sub dump_applied { } } +sub dump_unapplied { + my @results; + + my $dbh = $form->dbconnect_noauto(\%myconfig); + + $dbh->{PrintWarn} = 0; + $dbh->{PrintError} = 0; + + my @unapplied = $dbupgrader->unapplied_upgrade_scripts($dbh); + + $dbh->disconnect; + + if (!scalar @unapplied) { + print "All database upgrades have been applied.\n"; + } else { + print map { $_->{tag} . "\n" } @unapplied; + } +} + sub build_upgrade_order { my $name = shift; my $order = shift; - my $tag = shift; + my $tags = shift; my $control = $controls->{$name}; foreach my $dependency (@{ $control->{depends} }) { next if $tags->{$dependency}; $tags->{$dependency} = 1; - build_upgrade_order($dependency, $order, $tag); + build_upgrade_order($dependency, $order, $tags); } push @{ $order }, $name; @@ -339,31 +383,36 @@ sub build_upgrade_order { ####### ####### -eval { require "config/lx-erp.conf"; }; -eval { require "config/lx-erp-local.conf"; } if (-f "config/lx-erp-local.conf"); - -$form = Form->new(); -$locale = Locale->new("de", "login"); +$locale = Locale->new; +$form = Form->new; ####### ####### ####### -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, - "apply=s" => \$opt_apply, - "applied" => \$opt_applied, - "help" => \$opt_help, +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, + "apply=s" => \$opt_apply, + "applied" => \$opt_applied, + "unapplied" => \$opt_unapplied, + "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, + "help" => \$opt_help, ); show_help() if ($opt_help); -$controls = parse_dbupdate_controls($form, "Pg"); +$dbupgrader = SL::DBUpgrade2->new(form => $form, dbdriver => 'Pg'); +$controls = $dbupgrader->parse_dbupdate_controls->{all_controls}; dump_list() if ($opt_list); dump_tree() if ($opt_tree); @@ -401,3 +450,34 @@ if ($opt_applied) { $form->error("--applied used but no user name given with --user.") if (!$user); dump_applied(); } + +if ($opt_unapplied) { + $form->error("--unapplied used but no user name given with --user.") if (!$user); + dump_unapplied(); +} + +if ($opt_test_utf8) { + $form->error("--test-utf8 used but no database name given with --dbname.") if (!$opt_dbname); + + my $umlaut_upper = 'Ä'; + + my $dbconnect = "dbi:Pg:dbname=${opt_dbname}"; + $dbconnect .= ";host=${opt_dbhost}" if ($opt_dbhost); + $dbconnect .= ";port=${opt_dbport}" if ($opt_dbport); + + my $dbh = DBI->connect($dbconnect, $opt_dbuser, $opt_dbpassword, { pg_enable_utf8 => 1 }); + + $form->error("UTF-8 test: Database connect failed (" . $DBI::errstr . ")") if (!$dbh); + + my ($umlaut_lower) = $dbh->selectrow_array(qq|SELECT lower(?)|, undef, $umlaut_upper); + + $dbh->disconnect(); + + if ($umlaut_lower eq 'ä') { + print "UTF-8 test was successful.\n"; + } elsif ($umlaut_lower eq 'Ä') { + 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"; + } +}