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   $form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name});
 163
 164   my (@order, %tags);
 165
 166   build_upgrade_order($name, \@order, \%tags);
 167
 168   my @upgradescripts = map { $controls->{$_}->{"applied"} = 0; $controls->{$_} } @order;
 169
 170   my $dbh = $form->dbconnect_noauto(\%myconfig);
 171
 172   $dbh->{PrintWarn}  = 0;
 173   $dbh->{PrintError} = 0;
 174
 175   $user->create_schema_info_table($form, $dbh);
 176
 177   my $query = qq|SELECT tag FROM schema_info|;
 178   $sth = $dbh->prepare($query);
 179   $sth->execute() || $form->dberror($query);
 180   while (($tag) = $sth->fetchrow_array()) {
 181     $controls->{$tag}->{"applied"} = 1 if defined $controls->{$tag};
 182   }
 183   $sth->finish();
 184
 185   my $all_applied = 1;
 186   foreach (@upgradescripts) {
 187     if (!$_->{"applied"}) {
 188       $all_applied = 0;
 189       last;
 190     }
 191   }
 192
 193   if ($all_applied) {
 194     print "The upgrade has already been applied.\n";
 195     exit 0;
 196   }
 197
 198   foreach my $control (@upgradescripts) {
 199     next if ($control->{"applied"});
 200
 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 }
 232
 233 #######
 234 #######
 235 #######
 236
 237 eval { require "lx-erp.conf"; };
 238
 239 $form = Form->new();
 240 $locale = Locale->new("de", "login");
 241
 242 #######
 243 #######
 244 #######
 245
 246 GetOptions("list" => \$opt_list,
 247            "tree" => \$opt_tree,
 248            "rtree" => \$opt_rtree,
 249            "nodeps" => \$opt_nodeps,
 250            "graphviz" => \$opt_graphviz,
 251            "user=s" => \$opt_user,
 252            "apply=s" => \$opt_apply,
 253            "help" => \$opt_help,
 254   );
 255
 256 if ($opt_help) {
 257   show_help();
 258   exit(0);
 259 }
 260
 261 $controls = parse_dbupdate_controls($form, "Pg");
 262
 263 if ($opt_list) {
 264   dump_list();
 265 }
 266
 267 if ($opt_tree) {
 268   dump_tree();
 269 }
 270
 271 if ($opt_rtree) {
 272   dump_tree_reverse();
 273 }
 274
 275 if ($opt_graphviz) {
 276   dump_graphviz();
 277 }
 278
 279 if ($opt_nodeps) {
 280   dump_nodeps();
 281 }
 282
 283 if ($opt_user) {
 284   my $file_name = "users/${opt_user}.conf";
 285
 286   eval { require($file_name); };
 287   $form->error("File '$file_name' was not found") if $@;
 288   $locale = new Locale($myconfig{countrycode}, "all");
 289   $user = new User("users/members", $opt_user);
 290   map { $form->{$_} = $myconfig{$_} } keys %myconfig;
 291 }
 292
 293 if ($opt_apply) {
 294   $form->error("--apply used but no configuration file given with --user.") if (!$user);
 295   apply_upgrade($opt_apply);
 296 }