scripts/dbupgrade2_tool.pl

   1 #!/usr/bin/perl
   2
   3 BEGIN {
   4   if (! -d "bin" || ! -d "SL") {
   5     print("This tool must be run from the Lx-Office ERP base directory.\n");
   6     exit(1);
   7   }
   8
   9   unshift @INC, "modules/YAML"; # Use our own version of YAML.
  10   push @INC, "modules";         # Only use our own versions of modules if there's no system version.
  11 }
  12
  13 use English '-no_match_vars';
  14
  15 use DBI;
  16 use Data::Dumper;
  17 use Getopt::Long;
  18
  19 use SL::LXDebug;
  20
  21 $lxdebug = LXDebug->new();
  22
  23 use SL::Form;
  24 use SL::User;
  25 use SL::Locale;
  26 use SL::DBUpgrade2;
  27 use SL::DBUtils;
  28
  29 #######
  30 #######
  31 #######
  32
  33 my ($opt_list, $opt_tree, $opt_rtree, $opt_nodeps, $opt_graphviz, $opt_help);
  34 my ($opt_user, $opt_apply);
  35
  36 our (%myconfig, $form, $user);
  37
  38 sub show_help {
  39   my $help_text = <<'END_HELP'
  40 dbupgrade2_tool.pl [options]
  41
  42   A validation and information tool for the database upgrade scripts
  43   in 'sql/Pg-upgrade2'.
  44
  45   At startup dbupgrade2_tool.pl will always check the consistency
  46   of all database upgrade scripts (e.g. circular references, invalid
  47   formats, missing meta information). You can but don't have to specifiy
  48   additional actions.
  49
  50   Actions:
  51     --list               Lists all database upgrade tags
  52     --tree               Lists all database upgrades in tree form
  53     --rtree              Lists all database upgrades in reverse tree form
  54     --graphviz[=file]    Create a Postscript document showing a tree of
  55                          all database upgrades and their dependencies.
  56                          If no file name is given then the output is
  57                          written to 'db_dependencies.ps'.
  58     --apply=tag          Applies the database upgrades 'tag' and all
  59                          upgrades it depends on. If '--apply' is used
  60                          then the option '--user' must be used as well.
  61     --help               Show this help and exit.
  62
  63   Options:
  64     --user=name          The name of the user configuration to use for
  65                          database connectivity.
  66 END_HELP
  67     ;
  68
  69   print $help_text;
  70   exit 0;
  71 }
  72
  73 sub error {
  74 }
  75
  76 sub calc_rev_depends {
  77   map({ $_->{"rev_depends"} = []; } values(%{$controls}));
  78   foreach my $control (values(%{$controls})) {
  79     map({ push(@{$controls->{$_}{"rev_depends"}}, $control->{"tag"}) }
  80         @{$control->{"depends"}});
  81   }
  82 }
  83
  84 sub dump_list {
  85   my @sorted_controls = sort_dbupdate_controls($controls);
  86
  87   print("LIST VIEW\n\n");
  88   print("number tag depth priority\n");
  89   $i = 0;
  90   foreach (@sorted_controls) {
  91     print("$i $_->{tag} $_->{depth} $_->{priority}\n");
  92     $i++;
  93   }
  94
  95   print("\n");
  96 }
  97
  98 sub dump_node {
  99   my ($tag, $depth) = @_;
 100
 101   print(" " x $depth . $tag . "\n");
 102
 103   my $c = $controls->{$tag};
 104   my $num = scalar(@{$c->{"depends"}});
 105   for (my $i = 0; $i < $num; $i++) {
 106     dump_node($c->{"depends"}[$i], $depth + 1);
 107   }
 108 }
 109
 110 sub dump_tree {
 111   print("TREE VIEW\n\n");
 112
 113   calc_rev_depends();
 114
 115   my @sorted_controls = sort_dbupdate_controls($controls);
 116
 117   foreach my $control (@sorted_controls) {
 118     dump_node($control->{"tag"}, "") unless (@{$control->{"rev_depends"}});
 119   }
 120
 121   print("\n");
 122 }
 123
 124 sub dump_node_reverse {
 125   my ($tag, $depth) = @_;
 126
 127   print(" " x $depth . $tag . "\n");
 128
 129   my $c = $controls->{$tag};
 130   my $num = scalar(@{$c->{"rev_depends"}});
 131   for (my $i = 0; $i < $num; $i++) {
 132     dump_node_reverse($c->{"rev_depends"}[$i], $depth + 1);
 133   }
 134 }
 135
 136 sub dump_tree_reverse {
 137   print("REVERSE TREE VIEW\n\n");
 138
 139   calc_rev_depends();
 140
 141   my @sorted_controls = sort_dbupdate_controls($controls);
 142
 143   foreach my $control (@sorted_controls) {
 144     last if ($control->{"depth"} > 1);
 145     dump_node_reverse($control->{"tag"}, "");
 146   }
 147
 148   print("\n");
 149 }
 150
 151 sub dump_graphviz {
 152   my $file_name = shift || "db_dependencies.ps";
 153
 154   print("GRAPHVIZ POSTCRIPT\n\n");
 155   print("Output will be written to '${file_name}'\n");
 156
 157   calc_rev_depends();
 158
 159   $dot = "|dot -Tps ";
 160   open OUT, "${dot}> \"${file_name}\"" || die;
 161
 162   print(OUT
 163         "digraph db_dependencies {\n" .
 164         "node [shape=box style=filled fillcolor=white];\n");
 165   my %ranks;
 166   foreach my $c (values(%{$controls})) {
 167     $ranks{$c->{"depth"}} ||= [];
 168
 169     my ($pre, $post) = ('node [fillcolor=lightgray] ', 'node [fillcolor=white] ') if !@{ $c->{"rev_depends"} };
 170
 171     push @{ $ranks{$c->{"depth"}} }, qq|${pre}"$c->{tag}"; ${post}|;
 172   }
 173   foreach (sort(keys(%ranks))) {
 174     print OUT "{ rank = same; ", join("", @{ $ranks{$_} }), " }\n";
 175   }
 176   foreach my $c (values(%{$controls})) {
 177     print(OUT "$c->{tag};\n");
 178     foreach my $d (@{$c->{"depends"}}) {
 179       print(OUT "$c->{tag} -> $d;\n");
 180     }
 181   }
 182   print(OUT "}\n");
 183   close(OUT);
 184 }
 185
 186 sub dump_nodeps {
 187   calc_rev_depends();
 188
 189   print("SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" .
 190         join("\n",
 191              map({ $_->{"tag"} }
 192                  grep({ !@{$_->{"rev_depends"}} }
 193                       values(%{$controls})))) .
 194         "\n\n");
 195 }
 196
 197 sub apply_upgrade {
 198   my $name = shift;
 199
 200   my (@order, %tags, @all_tags);
 201
 202   if ($name eq "ALL") {
 203     calc_rev_depends();
 204     @all_tags = map { $_->{"tag"} } grep { !@{$_->{"rev_depends"}} } values %{$controls};
 205
 206   } else {
 207     $form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name});
 208     @all_tags = ($name);
 209   }
 210
 211   foreach my $tag (@all_tags) {
 212     build_upgrade_order($tag, \@order, \%tags);
 213   }
 214
 215   my @upgradescripts = map { $controls->{$_}->{"applied"} = 0; $controls->{$_} } @order;
 216
 217   my $dbh = $form->dbconnect_noauto(\%myconfig);
 218
 219   $dbh->{PrintWarn}  = 0;
 220   $dbh->{PrintError} = 0;
 221
 222   $user->create_schema_info_table($form, $dbh);
 223
 224   my $query = qq|SELECT tag FROM schema_info|;
 225   $sth = $dbh->prepare($query);
 226   $sth->execute() || $form->dberror($query);
 227   while (($tag) = $sth->fetchrow_array()) {
 228     $controls->{$tag}->{"applied"} = 1 if defined $controls->{$tag};
 229   }
 230   $sth->finish();
 231
 232   @upgradescripts = sort { $a->{"priority"} <=> $b->{"priority"} } grep { !$_->{"applied"} } @upgradescripts;
 233   if (!@upgradescripts) {
 234     print "The upgrade has already been applied.\n";
 235     exit 0;
 236   }
 237
 238   foreach my $control (@upgradescripts) {
 239     $control->{"file"} =~ /\.(sql|pl)$/;
 240     my $file_type = $1;
 241
 242     # apply upgrade
 243     print "Applying upgrade $control->{file}\n";
 244
 245     if ($file_type eq "sql") {
 246       $user->process_query($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 247     } else {
 248       $user->process_perl_script($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 249     }
 250   }
 251
 252   $dbh->disconnect();
 253 }
 254
 255 sub build_upgrade_order {
 256   my $name  = shift;
 257   my $order = shift;
 258   my $tag   = shift;
 259
 260   my $control = $controls->{$name};
 261
 262   foreach my $dependency (@{ $control->{"depends"} }) {
 263     next if $tags->{$dependency};
 264     $tags->{$dependency} = 1;
 265     build_upgrade_order($dependency, $order, $tag);
 266   }
 267
 268   push @{ $order }, $name;
 269   $tags->{$name} = 1;
 270 }
 271
 272 #######
 273 #######
 274 #######
 275
 276 eval { require "lx-erp.conf"; };
 277
 278 $form = Form->new();
 279 $locale = Locale->new("de", "login");
 280
 281 #######
 282 #######
 283 #######
 284
 285 GetOptions("list" => \$opt_list,
 286            "tree" => \$opt_tree,
 287            "rtree" => \$opt_rtree,
 288            "nodeps" => \$opt_nodeps,
 289            "graphviz:s" => \$opt_graphviz,
 290            "user=s" => \$opt_user,
 291            "apply=s" => \$opt_apply,
 292            "help" => \$opt_help,
 293   );
 294
 295 if ($opt_help) {
 296   show_help();
 297 }
 298
 299 $controls = parse_dbupdate_controls($form, "Pg");
 300
 301 if ($opt_list) {
 302   dump_list();
 303 }
 304
 305 if ($opt_tree) {
 306   dump_tree();
 307 }
 308
 309 if ($opt_rtree) {
 310   dump_tree_reverse();
 311 }
 312
 313 if (defined $opt_graphviz) {
 314   dump_graphviz($opt_graphviz);
 315 }
 316
 317 if ($opt_nodeps) {
 318   dump_nodeps();
 319 }
 320
 321 if ($opt_user) {
 322   my $file_name = "users/${opt_user}.conf";
 323
 324   eval { require($file_name); };
 325   $form->error("File '$file_name' was not found") if $@;
 326   $locale = new Locale($myconfig{countrycode}, "all");
 327   $user = new User("users/members", $opt_user);
 328   map { $form->{$_} = $myconfig{$_} } keys %myconfig;
 329 }
 330
 331 if ($opt_apply) {
 332   $form->error("--apply used but no configuration file given with --user.") if (!$user);
 333   apply_upgrade($opt_apply);
 334 }