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/override"; # Use our own versions of various modules (e.g. YAML).
  10   push    @INC, "modules/fallback"; # 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     --nodeps             List all database upgrades that no other upgrade
  59                          depends on
  60     --apply=tag          Applies the database upgrades 'tag' and all
  61                          upgrades it depends on. If '--apply' is used
  62                          then the option '--user' must be used as well.
  63     --help               Show this help and exit.
  64
  65   Options:
  66     --user=name          The name of the user configuration to use for
  67                          database connectivity.
  68 END_HELP
  69     ;
  70
  71   # Syntax-Highlighting-Fix für Emacs: '
  72
  73   print $help_text;
  74
  75   exit 0;
  76 }
  77
  78 sub error {
  79 }
  80
  81 sub calc_rev_depends {
  82   map({ $_->{"rev_depends"} = []; } values(%{$controls}));
  83   foreach my $control (values(%{$controls})) {
  84     map({ push(@{$controls->{$_}{"rev_depends"}}, $control->{"tag"}) }
  85         @{$control->{"depends"}});
  86   }
  87 }
  88
  89 sub dump_list {
  90   my @sorted_controls = sort_dbupdate_controls($controls);
  91
  92   print("LIST VIEW\n\n");
  93   print("number tag depth priority\n");
  94   $i = 0;
  95   foreach (@sorted_controls) {
  96     print("$i $_->{tag} $_->{depth} $_->{priority}\n");
  97     $i++;
  98   }
  99
 100   print("\n");
 101 }
 102
 103 sub dump_node {
 104   my ($tag, $depth) = @_;
 105
 106   print(" " x $depth . $tag . "\n");
 107
 108   my $c = $controls->{$tag};
 109   my $num = scalar(@{$c->{"depends"}});
 110   for (my $i = 0; $i < $num; $i++) {
 111     dump_node($c->{"depends"}[$i], $depth + 1);
 112   }
 113 }
 114
 115 sub dump_tree {
 116   print("TREE VIEW\n\n");
 117
 118   calc_rev_depends();
 119
 120   my @sorted_controls = sort_dbupdate_controls($controls);
 121
 122   foreach my $control (@sorted_controls) {
 123     dump_node($control->{"tag"}, "") unless (@{$control->{"rev_depends"}});
 124   }
 125
 126   print("\n");
 127 }
 128
 129 sub dump_node_reverse {
 130   my ($tag, $depth) = @_;
 131
 132   print(" " x $depth . $tag . "\n");
 133
 134   my $c = $controls->{$tag};
 135   my $num = scalar(@{$c->{"rev_depends"}});
 136   for (my $i = 0; $i < $num; $i++) {
 137     dump_node_reverse($c->{"rev_depends"}[$i], $depth + 1);
 138   }
 139 }
 140
 141 sub dump_tree_reverse {
 142   print("REVERSE TREE VIEW\n\n");
 143
 144   calc_rev_depends();
 145
 146   my @sorted_controls = sort_dbupdate_controls($controls);
 147
 148   foreach my $control (@sorted_controls) {
 149     last if ($control->{"depth"} > 1);
 150     dump_node_reverse($control->{"tag"}, "");
 151   }
 152
 153   print("\n");
 154 }
 155
 156 sub dump_graphviz {
 157   my $file_name = shift || "db_dependencies.ps";
 158
 159   print("GRAPHVIZ POSTCRIPT\n\n");
 160   print("Output will be written to '${file_name}'\n");
 161
 162   calc_rev_depends();
 163
 164   $dot = "|dot -Tps ";
 165   open OUT, "${dot}> \"${file_name}\"" || die;
 166
 167   print(OUT
 168         "digraph db_dependencies {\n" .
 169         "node [shape=box style=filled fillcolor=white];\n");
 170   my %ranks;
 171   foreach my $c (values(%{$controls})) {
 172     $ranks{$c->{"depth"}} ||= [];
 173
 174     my ($pre, $post) = ('node [fillcolor=lightgray] ', 'node [fillcolor=white] ') if !@{ $c->{"rev_depends"} };
 175
 176     push @{ $ranks{$c->{"depth"}} }, qq|${pre}"$c->{tag}"; ${post}|;
 177   }
 178   foreach (sort(keys(%ranks))) {
 179     print OUT "{ rank = same; ", join("", @{ $ranks{$_} }), " }\n";
 180   }
 181   foreach my $c (values(%{$controls})) {
 182     print(OUT "$c->{tag};\n");
 183     foreach my $d (@{$c->{"depends"}}) {
 184       print(OUT "$c->{tag} -> $d;\n");
 185     }
 186   }
 187   print(OUT "}\n");
 188   close(OUT);
 189 }
 190
 191 sub dump_nodeps {
 192   calc_rev_depends();
 193
 194   print("SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" .
 195         join("\n",
 196              map({ $_->{"tag"} }
 197                  grep({ !@{$_->{"rev_depends"}} }
 198                       values(%{$controls})))) .
 199         "\n\n");
 200 }
 201
 202 sub apply_upgrade {
 203   my $name = shift;
 204
 205   my (@order, %tags, @all_tags);
 206
 207   if ($name eq "ALL") {
 208     calc_rev_depends();
 209     @all_tags = map { $_->{"tag"} } grep { !@{$_->{"rev_depends"}} } values %{$controls};
 210
 211   } else {
 212     $form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name});
 213     @all_tags = ($name);
 214   }
 215
 216   foreach my $tag (@all_tags) {
 217     build_upgrade_order($tag, \@order, \%tags);
 218   }
 219
 220   my @upgradescripts = map { $controls->{$_}->{"applied"} = 0; $controls->{$_} } @order;
 221
 222   my $dbh = $form->dbconnect_noauto(\%myconfig);
 223
 224   $dbh->{PrintWarn}  = 0;
 225   $dbh->{PrintError} = 0;
 226
 227   $user->create_schema_info_table($form, $dbh);
 228
 229   my $query = qq|SELECT tag FROM schema_info|;
 230   $sth = $dbh->prepare($query);
 231   $sth->execute() || $form->dberror($query);
 232   while (($tag) = $sth->fetchrow_array()) {
 233     $controls->{$tag}->{"applied"} = 1 if defined $controls->{$tag};
 234   }
 235   $sth->finish();
 236
 237   @upgradescripts = sort { $a->{"priority"} <=> $b->{"priority"} } grep { !$_->{"applied"} } @upgradescripts;
 238   if (!@upgradescripts) {
 239     print "The upgrade has already been applied.\n";
 240     exit 0;
 241   }
 242
 243   foreach my $control (@upgradescripts) {
 244     $control->{"file"} =~ /\.(sql|pl)$/;
 245     my $file_type = $1;
 246
 247     # apply upgrade
 248     print "Applying upgrade $control->{file}\n";
 249
 250     if ($file_type eq "sql") {
 251       $user->process_query($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 252     } else {
 253       $user->process_perl_script($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 254     }
 255   }
 256
 257   $dbh->disconnect();
 258 }
 259
 260 sub build_upgrade_order {
 261   my $name  = shift;
 262   my $order = shift;
 263   my $tag   = shift;
 264
 265   my $control = $controls->{$name};
 266
 267   foreach my $dependency (@{ $control->{"depends"} }) {
 268     next if $tags->{$dependency};
 269     $tags->{$dependency} = 1;
 270     build_upgrade_order($dependency, $order, $tag);
 271   }
 272
 273   push @{ $order }, $name;
 274   $tags->{$name} = 1;
 275 }
 276
 277 #######
 278 #######
 279 #######
 280
 281 eval { require "lx-erp.conf"; };
 282
 283 $form = Form->new();
 284 $locale = Locale->new("de", "login");
 285
 286 #######
 287 #######
 288 #######
 289
 290 GetOptions("list" => \$opt_list,
 291            "tree" => \$opt_tree,
 292            "rtree" => \$opt_rtree,
 293            "nodeps" => \$opt_nodeps,
 294            "graphviz:s" => \$opt_graphviz,
 295            "user=s" => \$opt_user,
 296            "apply=s" => \$opt_apply,
 297            "help" => \$opt_help,
 298   );
 299
 300 if ($opt_help) {
 301   show_help();
 302 }
 303
 304 $controls = parse_dbupdate_controls($form, "Pg");
 305
 306 if ($opt_list) {
 307   dump_list();
 308 }
 309
 310 if ($opt_tree) {
 311   dump_tree();
 312 }
 313
 314 if ($opt_rtree) {
 315   dump_tree_reverse();
 316 }
 317
 318 if (defined $opt_graphviz) {
 319   dump_graphviz($opt_graphviz);
 320 }
 321
 322 if ($opt_nodeps) {
 323   dump_nodeps();
 324 }
 325
 326 if ($opt_user) {
 327   my $file_name = "users/${opt_user}.conf";
 328
 329   eval { require($file_name); };
 330   $form->error("File '$file_name' was not found") if $@;
 331   $locale = new Locale($myconfig{countrycode}, "all");
 332   $user = new User("users/members", $opt_user);
 333   map { $form->{$_} = $myconfig{$_} } keys %myconfig;
 334 }
 335
 336 if ($opt_apply) {
 337   $form->error("--apply used but no configuration file given with --user.") if (!$user);
 338   apply_upgrade($opt_apply);
 339 }