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   print("dbupgrade2_tool.pl [--list] [--tree] [--rtree] [--graphviz]\n" .
  39         "                   [--nodepds] [--user=name --apply=tag] [--help]\n");
  40 }
  41
  42 sub error {
  43 }
  44
  45 sub calc_rev_depends {
  46   map({ $_->{"rev_depends"} = []; } values(%{$controls}));
  47   foreach my $control (values(%{$controls})) {
  48     map({ push(@{$controls->{$_}{"rev_depends"}}, $control->{"tag"}) }
  49         @{$control->{"depends"}});
  50   }
  51 }
  52
  53 sub dump_list {
  54   my @sorted_controls = sort_dbupdate_controls($controls);
  55
  56   print("LIST VIEW\n\n");
  57   print("number tag depth priority\n");
  58   $i = 0;
  59   foreach (@sorted_controls) {
  60     print("$i $_->{tag} $_->{depth} $_->{priority}\n");
  61     $i++;
  62   }
  63
  64   print("\n");
  65 }
  66
  67 sub dump_node {
  68   my ($tag, $depth) = @_;
  69
  70   print(" " x $depth . $tag . "\n");
  71
  72   my $c = $controls->{$tag};
  73   my $num = scalar(@{$c->{"depends"}});
  74   for (my $i = 0; $i < $num; $i++) {
  75     dump_node($c->{"depends"}[$i], $depth + 1);
  76   }
  77 }
  78
  79 sub dump_tree {
  80   print("TREE VIEW\n\n");
  81
  82   calc_rev_depends();
  83
  84   my @sorted_controls = sort_dbupdate_controls($controls);
  85
  86   foreach my $control (@sorted_controls) {
  87     dump_node($control->{"tag"}, "") unless (@{$control->{"rev_depends"}});
  88   }
  89
  90   print("\n");
  91 }
  92
  93 sub dump_node_reverse {
  94   my ($tag, $depth) = @_;
  95
  96   print(" " x $depth . $tag . "\n");
  97
  98   my $c = $controls->{$tag};
  99   my $num = scalar(@{$c->{"rev_depends"}});
 100   for (my $i = 0; $i < $num; $i++) {
 101     dump_node_reverse($c->{"rev_depends"}[$i], $depth + 1);
 102   }
 103 }
 104
 105 sub dump_tree_reverse {
 106   print("REVERSE TREE VIEW\n\n");
 107
 108   calc_rev_depends();
 109
 110   my @sorted_controls = sort_dbupdate_controls($controls);
 111
 112   foreach my $control (@sorted_controls) {
 113     last if ($control->{"depth"} > 1);
 114     dump_node_reverse($control->{"tag"}, "");
 115   }
 116
 117   print("\n");
 118 }
 119
 120 sub dump_graphviz {
 121   print("GRAPHVIZ POSTCRIPT\n\n");
 122   print("Output will be written to db_dependencies.ps\n");
 123   $dot = "|dot -Tps ";
 124   open(OUT, "${dot}> db_dependencies.ps");
 125   print(OUT
 126         "digraph db_dependencies {\n" .
 127         "node [shape=box];\n");
 128   my %ranks;
 129   foreach my $c (values(%{$controls})) {
 130     $ranks{$c->{"depth"}} = [] unless ($ranks{$c->{"depth"}});
 131     push(@{$ranks{$c->{"depth"}}}, $c->{"tag"});
 132   }
 133   foreach (sort(keys(%ranks))) {
 134     print(OUT "{ rank = same; " .
 135           join("", map({ '"' . $_ . '"; ' } @{$ranks{$_}})) .
 136           " }\n");
 137   }
 138   foreach my $c (values(%{$controls})) {
 139     print(OUT "$c->{tag};\n");
 140     foreach my $d (@{$c->{"depends"}}) {
 141       print(OUT "$c->{tag} -> $d;\n");
 142     }
 143   }
 144   print(OUT "}\n");
 145   close(OUT);
 146 }
 147
 148 sub dump_nodeps {
 149   calc_rev_depends();
 150
 151   print("SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" .
 152         join("\n",
 153              map({ $_->{"tag"} }
 154                  grep({ !@{$_->{"rev_depends"}} }
 155                       values(%{$controls})))) .
 156         "\n\n");
 157 }
 158
 159 sub apply_upgrade {
 160   my $name = shift;
 161
 162   my (@order, %tags, @all_tags);
 163
 164   if ($name eq "ALL") {
 165     calc_rev_depends();
 166     @all_tags = map { $_->{"tag"} } grep { !@{$_->{"rev_depends"}} } values %{$controls};
 167
 168   } else {
 169     $form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name});
 170     @all_tags = ($name);
 171   }
 172
 173   foreach my $tag (@all_tags) {
 174     build_upgrade_order($tag, \@order, \%tags);
 175   }
 176
 177   my @upgradescripts = map { $controls->{$_}->{"applied"} = 0; $controls->{$_} } @order;
 178
 179   my $dbh = $form->dbconnect_noauto(\%myconfig);
 180
 181   $dbh->{PrintWarn}  = 0;
 182   $dbh->{PrintError} = 0;
 183
 184   $user->create_schema_info_table($form, $dbh);
 185
 186   my $query = qq|SELECT tag FROM schema_info|;
 187   $sth = $dbh->prepare($query);
 188   $sth->execute() || $form->dberror($query);
 189   while (($tag) = $sth->fetchrow_array()) {
 190     $controls->{$tag}->{"applied"} = 1 if defined $controls->{$tag};
 191   }
 192   $sth->finish();
 193
 194   @upgradescripts = sort { $a->{"priority"} <=> $b->{"priority"} } grep { !$_->{"applied"} } @upgradescripts;
 195   if (!@upgradescripts) {
 196     print "The upgrade has already been applied.\n";
 197     exit 0;
 198   }
 199
 200   foreach my $control (@upgradescripts) {
 201     $control->{"file"} =~ /\.(sql|pl)$/;
 202     my $file_type = $1;
 203
 204     # apply upgrade
 205     print "Applying upgrade $control->{file}\n";
 206
 207     if ($file_type eq "sql") {
 208       $user->process_query($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 209     } else {
 210       $user->process_perl_script($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 211     }
 212   }
 213
 214   $dbh->disconnect();
 215 }
 216
 217 sub build_upgrade_order {
 218   my $name  = shift;
 219   my $order = shift;
 220   my $tag   = shift;
 221
 222   my $control = $controls->{$name};
 223
 224   foreach my $dependency (@{ $control->{"depends"} }) {
 225     next if $tags->{$dependency};
 226     $tags->{$dependency} = 1;
 227     build_upgrade_order($dependency, $order, $tag);
 228   }
 229
 230   push @{ $order }, $name;
 231   $tags->{$name} = 1;
 232 }
 233
 234 #######
 235 #######
 236 #######
 237
 238 eval { require "lx-erp.conf"; };
 239
 240 $form = Form->new();
 241 $locale = Locale->new("de", "login");
 242
 243 #######
 244 #######
 245 #######
 246
 247 GetOptions("list" => \$opt_list,
 248            "tree" => \$opt_tree,
 249            "rtree" => \$opt_rtree,
 250            "nodeps" => \$opt_nodeps,
 251            "graphviz" => \$opt_graphviz,
 252            "user=s" => \$opt_user,
 253            "apply=s" => \$opt_apply,
 254            "help" => \$opt_help,
 255   );
 256
 257 if ($opt_help) {
 258   show_help();
 259   exit(0);
 260 }
 261
 262 $controls = parse_dbupdate_controls($form, "Pg");
 263
 264 if ($opt_list) {
 265   dump_list();
 266 }
 267
 268 if ($opt_tree) {
 269   dump_tree();
 270 }
 271
 272 if ($opt_rtree) {
 273   dump_tree_reverse();
 274 }
 275
 276 if ($opt_graphviz) {
 277   dump_graphviz();
 278 }
 279
 280 if ($opt_nodeps) {
 281   dump_nodeps();
 282 }
 283
 284 if ($opt_user) {
 285   my $file_name = "users/${opt_user}.conf";
 286
 287   eval { require($file_name); };
 288   $form->error("File '$file_name' was not found") if $@;
 289   $locale = new Locale($myconfig{countrycode}, "all");
 290   $user = new User("users/members", $opt_user);
 291   map { $form->{$_} = $myconfig{$_} } keys %myconfig;
 292 }
 293
 294 if ($opt_apply) {
 295   $form->error("--apply used but no configuration file given with --user.") if (!$user);
 296   apply_upgrade($opt_apply);
 297 }