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
 156   calc_rev_depends();
 157
 158   $dot = "|dot -Tps ";
 159   open OUT, "${dot}> \"${file_name}\"" || die;
 160
 161   print(OUT
 162         "digraph db_dependencies {\n" .
 163         "node [shape=box style=filled fillcolor=white];\n");
 164   my %ranks;
 165   foreach my $c (values(%{$controls})) {
 166     $ranks{$c->{"depth"}} ||= [];
 167
 168     my ($pre, $post) = ('node [fillcolor=lightgray] ', 'node [fillcolor=white] ') if !@{ $c->{"rev_depends"} };
 169
 170     push @{ $ranks{$c->{"depth"}} }, qq|${pre}"$c->{tag}"; ${post}|;
 171   }
 172   foreach (sort(keys(%ranks))) {
 173     print OUT "{ rank = same; ", join("", @{ $ranks{$_} }), " }\n";
 174   }
 175   foreach my $c (values(%{$controls})) {
 176     print(OUT "$c->{tag};\n");
 177     foreach my $d (@{$c->{"depends"}}) {
 178       print(OUT "$c->{tag} -> $d;\n");
 179     }
 180   }
 181   print(OUT "}\n");
 182   close(OUT);
 183 }
 184
 185 sub dump_nodeps {
 186   calc_rev_depends();
 187
 188   print("SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" .
 189         join("\n",
 190              map({ $_->{"tag"} }
 191                  grep({ !@{$_->{"rev_depends"}} }
 192                       values(%{$controls})))) .
 193         "\n\n");
 194 }
 195
 196 sub apply_upgrade {
 197   my $name = shift;
 198
 199   my (@order, %tags, @all_tags);
 200
 201   if ($name eq "ALL") {
 202     calc_rev_depends();
 203     @all_tags = map { $_->{"tag"} } grep { !@{$_->{"rev_depends"}} } values %{$controls};
 204
 205   } else {
 206     $form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name});
 207     @all_tags = ($name);
 208   }
 209
 210   foreach my $tag (@all_tags) {
 211     build_upgrade_order($tag, \@order, \%tags);
 212   }
 213
 214   my @upgradescripts = map { $controls->{$_}->{"applied"} = 0; $controls->{$_} } @order;
 215
 216   my $dbh = $form->dbconnect_noauto(\%myconfig);
 217
 218   $dbh->{PrintWarn}  = 0;
 219   $dbh->{PrintError} = 0;
 220
 221   $user->create_schema_info_table($form, $dbh);
 222
 223   my $query = qq|SELECT tag FROM schema_info|;
 224   $sth = $dbh->prepare($query);
 225   $sth->execute() || $form->dberror($query);
 226   while (($tag) = $sth->fetchrow_array()) {
 227     $controls->{$tag}->{"applied"} = 1 if defined $controls->{$tag};
 228   }
 229   $sth->finish();
 230
 231   @upgradescripts = sort { $a->{"priority"} <=> $b->{"priority"} } grep { !$_->{"applied"} } @upgradescripts;
 232   if (!@upgradescripts) {
 233     print "The upgrade has already been applied.\n";
 234     exit 0;
 235   }
 236
 237   foreach my $control (@upgradescripts) {
 238     $control->{"file"} =~ /\.(sql|pl)$/;
 239     my $file_type = $1;
 240
 241     # apply upgrade
 242     print "Applying upgrade $control->{file}\n";
 243
 244     if ($file_type eq "sql") {
 245       $user->process_query($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 246     } else {
 247       $user->process_perl_script($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 248     }
 249   }
 250
 251   $dbh->disconnect();
 252 }
 253
 254 sub build_upgrade_order {
 255   my $name  = shift;
 256   my $order = shift;
 257   my $tag   = shift;
 258
 259   my $control = $controls->{$name};
 260
 261   foreach my $dependency (@{ $control->{"depends"} }) {
 262     next if $tags->{$dependency};
 263     $tags->{$dependency} = 1;
 264     build_upgrade_order($dependency, $order, $tag);
 265   }
 266
 267   push @{ $order }, $name;
 268   $tags->{$name} = 1;
 269 }
 270
 271 #######
 272 #######
 273 #######
 274
 275 eval { require "lx-erp.conf"; };
 276
 277 $form = Form->new();
 278 $locale = Locale->new("de", "login");
 279
 280 #######
 281 #######
 282 #######
 283
 284 GetOptions("list" => \$opt_list,
 285            "tree" => \$opt_tree,
 286            "rtree" => \$opt_rtree,
 287            "nodeps" => \$opt_nodeps,
 288            "graphviz:s" => \$opt_graphviz,
 289            "user=s" => \$opt_user,
 290            "apply=s" => \$opt_apply,
 291            "help" => \$opt_help,
 292   );
 293
 294 if ($opt_help) {
 295   show_help();
 296 }
 297
 298 $controls = parse_dbupdate_controls($form, "Pg");
 299
 300 if ($opt_list) {
 301   dump_list();
 302 }
 303
 304 if ($opt_tree) {
 305   dump_tree();
 306 }
 307
 308 if ($opt_rtree) {
 309   dump_tree_reverse();
 310 }
 311
 312 if (defined $opt_graphviz) {
 313   dump_graphviz($opt_graphviz);
 314 }
 315
 316 if ($opt_nodeps) {
 317   dump_nodeps();
 318 }
 319
 320 if ($opt_user) {
 321   my $file_name = "users/${opt_user}.conf";
 322
 323   eval { require($file_name); };
 324   $form->error("File '$file_name' was not found") if $@;
 325   $locale = new Locale($myconfig{countrycode}, "all");
 326   $user = new User("users/members", $opt_user);
 327   map { $form->{$_} = $myconfig{$_} } keys %myconfig;
 328 }
 329
 330 if ($opt_apply) {
 331   $form->error("--apply used but no configuration file given with --user.") if (!$user);
 332   apply_upgrade($opt_apply);
 333 }