print("This tool must be run from the Lx-Office ERP base directory.\n");
exit(1);
}
+
+ unshift @INC, "modules/YAML"; # Use our own version of YAML.
+ push @INC, "modules"; # Only use our own versions of modules if there's no system version.
}
+use English '-no_match_vars';
+
use DBI;
use Data::Dumper;
use Getopt::Long;
$lxdebug = LXDebug->new();
use SL::Form;
+use SL::User;
+use SL::Locale;
use SL::DBUpgrade2;
+use SL::DBUtils;
#######
#######
#######
+my ($opt_list, $opt_tree, $opt_rtree, $opt_nodeps, $opt_graphviz, $opt_help);
+my ($opt_user, $opt_apply);
+
+our (%myconfig, $form, $user);
+
sub show_help {
- print("dbupgrade2_tool.pl [--list] [--tree] [--rtree] [--graphviz]\n" .
- " [--nodepds] [--help]\n");
+ my $help_text = <<'END_HELP'
+dbupgrade2_tool.pl [options]
+
+ A validation and information tool for the database upgrade scripts
+ 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
+ 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
+ written to 'db_dependencies.ps'.
+ --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.
+ --help Show this help and exit.
+
+ Options:
+ --user=name The name of the user configuration to use for
+ database connectivity.
+END_HELP
+ ;
+
+ # Syntax-Highlighting-Fix für Emacs: '
+
+ print $help_text;
+
+ exit 0;
+}
+
+sub error {
}
sub calc_rev_depends {
}
sub dump_graphviz {
+ my $file_name = shift || "db_dependencies.ps";
+
print("GRAPHVIZ POSTCRIPT\n\n");
- print("Output will be written to db_dependencies.ps\n");
+ print("Output will be written to '${file_name}'\n");
+
+ calc_rev_depends();
+
$dot = "|dot -Tps ";
- open(OUT, "${dot}> db_dependencies.ps");
+ open OUT, "${dot}> \"${file_name}\"" || die;
+
print(OUT
"digraph db_dependencies {\n" .
- "node [shape=box];\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"});
+ $ranks{$c->{"depth"}} ||= [];
+
+ my ($pre, $post) = ('node [fillcolor=lightgray] ', 'node [fillcolor=white] ') if !@{ $c->{"rev_depends"} };
+
+ push @{ $ranks{$c->{"depth"}} }, qq|${pre}"$c->{tag}"; ${post}|;
}
foreach (sort(keys(%ranks))) {
- print(OUT "{ rank = same; " .
- join("", map({ '"' . $_ . '"; ' } @{$ranks{$_}})) .
- " }\n");
+ print OUT "{ rank = same; ", join("", @{ $ranks{$_} }), " }\n";
}
foreach my $c (values(%{$controls})) {
print(OUT "$c->{tag};\n");
"\n\n");
}
+sub apply_upgrade {
+ my $name = shift;
+
+ my (@order, %tags, @all_tags);
+
+ if ($name eq "ALL") {
+ calc_rev_depends();
+ @all_tags = map { $_->{"tag"} } grep { !@{$_->{"rev_depends"}} } values %{$controls};
+
+ } else {
+ $form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name});
+ @all_tags = ($name);
+ }
+
+ foreach my $tag (@all_tags) {
+ build_upgrade_order($tag, \@order, \%tags);
+ }
+
+ my @upgradescripts = map { $controls->{$_}->{"applied"} = 0; $controls->{$_} } @order;
+
+ my $dbh = $form->dbconnect_noauto(\%myconfig);
+
+ $dbh->{PrintWarn} = 0;
+ $dbh->{PrintError} = 0;
+
+ $user->create_schema_info_table($form, $dbh);
+
+ my $query = qq|SELECT tag FROM schema_info|;
+ $sth = $dbh->prepare($query);
+ $sth->execute() || $form->dberror($query);
+ while (($tag) = $sth->fetchrow_array()) {
+ $controls->{$tag}->{"applied"} = 1 if defined $controls->{$tag};
+ }
+ $sth->finish();
+
+ @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)$/;
+ 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);
+ } else {
+ $user->process_perl_script($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
+ }
+ }
+
+ $dbh->disconnect();
+}
+
+sub build_upgrade_order {
+ my $name = shift;
+ my $order = shift;
+ my $tag = shift;
+
+ my $control = $controls->{$name};
+
+ foreach my $dependency (@{ $control->{"depends"} }) {
+ next if $tags->{$dependency};
+ $tags->{$dependency} = 1;
+ build_upgrade_order($dependency, $order, $tag);
+ }
+
+ push @{ $order }, $name;
+ $tags->{$name} = 1;
+}
+
#######
#######
#######
#######
#######
-my ($opt_list, $opt_tree, $opt_rtree, $opt_nodeps, $opt_graphviz, $opt_help);
-
GetOptions("list" => \$opt_list,
"tree" => \$opt_tree,
"rtree" => \$opt_rtree,
"nodeps" => \$opt_nodeps,
- "graphviz" => \$opt_graphviz,
+ "graphviz:s" => \$opt_graphviz,
+ "user=s" => \$opt_user,
+ "apply=s" => \$opt_apply,
"help" => \$opt_help,
);
if ($opt_help) {
show_help();
- exit(0);
}
$controls = parse_dbupdate_controls($form, "Pg");
dump_tree_reverse();
}
-if ($opt_graphviz) {
- dump_graphviz();
+if (defined $opt_graphviz) {
+ dump_graphviz($opt_graphviz);
}
if ($opt_nodeps) {
dump_nodeps();
}
+
+if ($opt_user) {
+ my $file_name = "users/${opt_user}.conf";
+
+ 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;
+}
+
+if ($opt_apply) {
+ $form->error("--apply used but no configuration file given with --user.") if (!$user);
+ apply_upgrade($opt_apply);
+}