X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=scripts%2Fdbupgrade2_tool.pl;h=deee26409fbb78609aca9b7740006c5345ce28ca;hb=5333aff20118de7987f882696a9c41d64b9ac001;hp=31b997c3c24576008f65d615aa0014f588d625ac;hpb=92fc1394dae925962c06e0250d9f1901e89b96d1;p=kivitendo-erp.git diff --git a/scripts/dbupgrade2_tool.pl b/scripts/dbupgrade2_tool.pl index 31b997c3c..deee26409 100755 --- a/scripts/dbupgrade2_tool.pl +++ b/scripts/dbupgrade2_tool.pl @@ -6,44 +6,57 @@ BEGIN { exit(1); } - push(@INC, "modules"); + 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. } + +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; 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); +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); +our (%myconfig, $form, $user, $auth, $locale, $controls, $dbupgrader); sub show_help { - my $help_text = <<'END_HELP' + my $help_text = <<"END_HELP" dbupgrade2_tool.pl [options] A validation and information tool for the database upgrade scripts - in 'sql/Pg-upgrade2'. + in \'sql/Pg-upgrade2\'. At startup dbupgrade2_tool.pl will always check the consistency of all database upgrade scripts (e.g. circular references, invalid - formats, missing meta information). You can but don't have to specifiy + formats, missing meta information). You can but don\'t have to specifiy additional actions. Actions: @@ -53,19 +66,40 @@ dbupgrade2_tool.pl [options] --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 - written to 'db_dependencies.ps'. - --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. + 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. + --nodeps List all database upgrades that no other upgrade + depends on + --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. + --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 - ; +; print $help_text; + exit 0; } @@ -73,119 +107,128 @@ sub error { } sub calc_rev_depends { - map({ $_->{"rev_depends"} = []; } values(%{$controls})); - foreach my $control (values(%{$controls})) { - map({ push(@{$controls->{$_}{"rev_depends"}}, $control->{"tag"}) } - @{$control->{"depends"}}); + map { $_->{rev_depends} = []; } values %{ $controls }; + + foreach my $control (values %{ $controls }) { + map { push @{ $controls->{$_}->{rev_depends} }, $control->{tag} } @{ $control->{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"; - print("LIST VIEW\n\n"); - print("number tag depth priority\n"); - $i = 0; + my $i = 0; foreach (@sorted_controls) { - print("$i $_->{tag} $_->{depth} $_->{priority}\n"); + print "$i $_->{tag} $_->{depth} $_->{priority}\n"; $i++; } - print("\n"); + print "\n"; } sub dump_node { my ($tag, $depth) = @_; - print(" " x $depth . $tag . "\n"); + print " " x $depth . $tag . "\n"; - my $c = $controls->{$tag}; - my $num = scalar(@{$c->{"depends"}}); - for (my $i = 0; $i < $num; $i++) { - dump_node($c->{"depends"}[$i], $depth + 1); + foreach my $dep_tag (@{ $controls->{$tag}->{depends} }) { + dump_node($dep_tag, $depth + 1); } } sub dump_tree { - print("TREE VIEW\n\n"); + print "TREE VIEW\n\n"; 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"}}); + dump_node($control->{tag}, "") unless (@{ $control->{rev_depends} }); } - print("\n"); + print "\n"; } sub dump_node_reverse { my ($tag, $depth) = @_; - print(" " x $depth . $tag . "\n"); + print " " x $depth . $tag . "\n"; - my $c = $controls->{$tag}; - my $num = scalar(@{$c->{"rev_depends"}}); - for (my $i = 0; $i < $num; $i++) { - dump_node_reverse($c->{"rev_depends"}[$i], $depth + 1); + foreach my $dep_tag (@{ $controls->{$tag}->{rev_depends} }) { + dump_node_reverse($dep_tag, $depth + 1); } } sub dump_tree_reverse { - print("REVERSE TREE VIEW\n\n"); + print "REVERSE TREE VIEW\n\n"; 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); - dump_node_reverse($control->{"tag"}, ""); + last if ($control->{depth} > 1); + dump_node_reverse($control->{tag}, ""); } - print("\n"); + print "\n"; } sub dump_graphviz { - my $file_name = shift || "db_dependencies.ps"; - - print("GRAPHVIZ POSTCRIPT\n\n"); - print("Output will be written to '${file_name}'\n"); - $dot = "|dot -Tps "; - open(OUT, "${dot}> \"${file_name}\""); - print(OUT - "digraph db_dependencies {\n" . - "node [shape=box];\n"); + my %params = @_; + + my $format = $params{format} || "png"; + my $file_name = $params{file_name} || "db_dependencies.${format}"; + + print "GRAPHVIZ OUTPUT -- format: ${format}\n\n"; + print "Output will be written to '${file_name}'\n"; + + calc_rev_depends(); + + my $dot = "|dot -T${format} "; + open OUT, "${dot}> \"${file_name}\"" || die; + + print OUT + "digraph db_dependencies {\n" . + "graph [size=\"16.53,11.69!\"];\n" . + "node [shape=box style=filled fillcolor=white];\n"; + my %ranks; - foreach my $c (values(%{$controls})) { - $ranks{$c->{"depth"}} = [] unless ($ranks{$c->{"depth"}}); - push(@{$ranks{$c->{"depth"}}}, $c->{"tag"}); + foreach my $c (values %{ $controls }) { + $ranks{$c->{depth}} ||= []; + + my ($pre, $post) = @{ $c->{rev_depends} } ? ('')x2 : + (map "node [fillcolor=$_] ", qw(lightgray white)); + + push @{ $ranks{$c->{"depth"}} }, qq|${pre}"$c->{tag}"; ${post}|; } - foreach (sort(keys(%ranks))) { - print(OUT "{ rank = same; " . - join("", map({ '"' . $_ . '"; ' } @{$ranks{$_}})) . - " }\n"); + + foreach (sort keys %ranks) { + print OUT "{ rank = same; ", join("", @{ $ranks{$_} }), " }\n"; } - foreach my $c (values(%{$controls})) { - print(OUT "$c->{tag};\n"); - foreach my $d (@{$c->{"depends"}}) { - print(OUT "$c->{tag} -> $d;\n"); + + foreach my $c (values %{ $controls }) { + print OUT qq|"$c->{tag}";\n|; + + foreach my $d (@{ $c->{depends} }) { + print OUT qq|"$c->{tag}" -> "$d";\n|; } } - print(OUT "}\n"); - close(OUT); + + print OUT "}\n"; + close OUT; } sub dump_nodeps { calc_rev_depends(); - print("SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" . - join("\n", - map({ $_->{"tag"} } - grep({ !@{$_->{"rev_depends"}} } - values(%{$controls})))) . - "\n\n"); + print "SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" . + join("\n", map { $_->{tag} } grep { !scalar @{ $_->{rev_depends} } } values %{ $controls }) . + "\n\n"; } sub apply_upgrade { @@ -195,7 +238,7 @@ sub apply_upgrade { if ($name eq "ALL") { calc_rev_depends(); - @all_tags = map { $_->{"tag"} } grep { !@{$_->{"rev_depends"}} } values %{$controls}; + @all_tags = map { $_->{tag} } grep { !@{$_->{rev_depends}} } values %{ $controls }; } else { $form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name}); @@ -206,7 +249,7 @@ sub apply_upgrade { build_upgrade_order($tag, \@order, \%tags); } - my @upgradescripts = map { $controls->{$_}->{"applied"} = 0; $controls->{$_} } @order; + my @upgradescripts = map { $controls->{$_}->{applied} = 0; $controls->{$_} } @order; my $dbh = $form->dbconnect_noauto(\%myconfig); @@ -216,47 +259,120 @@ 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()) { - $controls->{$tag}->{"applied"} = 1 if defined $controls->{$tag}; + while (my ($tag) = $sth->fetchrow_array()) { + $controls->{$tag}->{applied} = 1 if defined $controls->{$tag}; } $sth->finish(); - @upgradescripts = sort { $a->{"priority"} <=> $b->{"priority"} } grep { !$_->{"applied"} } @upgradescripts; + @upgradescripts = sort { $a->{priority} <=> $b->{priority} } grep { !$_->{applied} } @upgradescripts; if (!@upgradescripts) { print "The upgrade has already been applied.\n"; exit 0; } foreach my $control (@upgradescripts) { - $control->{"file"} =~ /\.(sql|pl)$/; + $control->{file} =~ /\.(sql|pl)$/; my $file_type = $1; # 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); } } $dbh->disconnect(); } +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; + + my $dbh = $form->dbconnect_noauto(\%myconfig); + + $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|; + my $sth = $dbh->prepare($query); + $sth->execute() || $form->dberror($query); + while (my $ref = $sth->fetchrow_hashref()) { + push @results, $ref; + } + $sth->finish(); + + $dbh->disconnect(); + + if (!scalar @results) { + print "No database upgrades have been applied yet.\n"; + } else { + dump_sql_result(\@results, [qw(tag login itime)]); + } +} + +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"} }) { + 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; @@ -267,62 +383,101 @@ sub build_upgrade_order { ####### ####### -eval { require "lx-erp.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, - "user=s" => \$opt_user, - "apply=s" => \$opt_apply, - "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, ); -if ($opt_help) { - show_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}; -if ($opt_list) { - dump_list(); -} +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); + +if ($opt_user) { + $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 " . + "and to create them."); + } -if ($opt_tree) { - dump_tree(); + %myconfig = $auth->read_user($opt_user); + + if (!$myconfig{login}) { + $form->error($form->format_string("The user '#1' does not exist.", $opt_user)); + } + + $locale = new Locale($myconfig{countrycode}, "all"); + $user = new User($opt_user); + + map { $form->{$_} = $myconfig{$_} } keys %myconfig; } -if ($opt_rtree) { - dump_tree_reverse(); +if ($opt_apply) { + $form->error("--apply used but no user name given with --user.") if (!$user); + apply_upgrade($opt_apply); } -if (defined $opt_graphviz) { - dump_graphviz($opt_graphviz); +if ($opt_applied) { + $form->error("--applied used but no user name given with --user.") if (!$user); + dump_applied(); } -if ($opt_nodeps) { - dump_nodeps(); +if ($opt_unapplied) { + $form->error("--unapplied used but no user name given with --user.") if (!$user); + dump_unapplied(); } -if ($opt_user) { - my $file_name = "users/${opt_user}.conf"; +if ($opt_test_utf8) { + $form->error("--test-utf8 used but no database name given with --dbname.") if (!$opt_dbname); - eval { require($file_name); }; - $form->error("File '$file_name' was not found") if $@; - $locale = new Locale($myconfig{countrycode}, "all"); - $user = new User("users/members", $opt_user); - map { $form->{$_} = $myconfig{$_} } keys %myconfig; -} + my $umlaut_upper = 'Ä'; -if ($opt_apply) { - $form->error("--apply used but no configuration file given with --user.") if (!$user); - apply_upgrade($opt_apply); + 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"; + } }