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