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
  84   foreach my $control (values %{ $controls }) {
  85     map { push @{ $controls->{$_}->{rev_depends} }, $control->{tag} } @{ $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     "number tag depth priority\n";
  94
  95   $i = 0;
  96   foreach (@sorted_controls) {
  97     print "$i $_->{tag} $_->{depth} $_->{priority}\n";
  98     $i++;
  99   }
 100
 101   print "\n";
 102 }
 103
 104 sub dump_node {
 105   my ($tag, $depth) = @_;
 106
 107   print " " x $depth . $tag . "\n";
 108
 109   foreach my $dep_tag (@{ $controls->{$tag}->{depends} }) {
 110     dump_node($dep_tag, $depth + 1);
 111   }
 112 }
 113
 114 sub dump_tree {
 115   print "TREE VIEW\n\n";
 116
 117   calc_rev_depends();
 118
 119   my @sorted_controls = sort_dbupdate_controls($controls);
 120
 121   foreach my $control (@sorted_controls) {
 122     dump_node($control->{tag}, "") unless (@{ $control->{rev_depends} });
 123   }
 124
 125   print "\n";
 126 }
 127
 128 sub dump_node_reverse {
 129   my ($tag, $depth) = @_;
 130
 131   print " " x $depth . $tag . "\n";
 132
 133   foreach my $dep_tag (@{ $controls->{$tag}->{rev_depends} }) {
 134     dump_node_reverse($dep_tag, $depth + 1);
 135   }
 136 }
 137
 138 sub dump_tree_reverse {
 139   print "REVERSE TREE VIEW\n\n";
 140
 141   calc_rev_depends();
 142
 143   my @sorted_controls = sort_dbupdate_controls($controls);
 144
 145   foreach my $control (@sorted_controls) {
 146     last if ($control->{depth} > 1);
 147     dump_node_reverse($control->{tag}, "");
 148   }
 149
 150   print "\n";
 151 }
 152
 153 sub dump_graphviz {
 154   my $file_name = shift || "db_dependencies.ps";
 155
 156   print "GRAPHVIZ POSTCRIPT\n\n";
 157   print "Output will be written to '${file_name}'\n";
 158
 159   calc_rev_depends();
 160
 161   $dot = "|dot -Tps ";
 162   open OUT, "${dot}> \"${file_name}\"" || die;
 163
 164   print OUT
 165     "digraph db_dependencies {\n" .
 166     "node [shape=box style=filled fillcolor=white];\n";
 167
 168   my %ranks;
 169   foreach my $c (values %{ $controls }) {
 170     $ranks{$c->{depth}} ||= [];
 171
 172     my ($pre, $post) = ('node [fillcolor=lightgray] ', 'node [fillcolor=white] ') if (!scalar @{ $c->{rev_depends} });
 173
 174     push @{ $ranks{$c->{"depth"}} }, qq|${pre}"$c->{tag}"; ${post}|;
 175   }
 176
 177   foreach (sort keys %ranks) {
 178     print OUT "{ rank = same; ", join("", @{ $ranks{$_} }), " }\n";
 179   }
 180
 181   foreach my $c (values %{ $controls }) {
 182     print OUT "$c->{tag};\n";
 183
 184     foreach my $d (@{ $c->{depends} }) {
 185       print OUT "$c->{tag} -> $d;\n";
 186     }
 187   }
 188
 189   print OUT "}\n";
 190   close OUT;
 191 }
 192
 193 sub dump_nodeps {
 194   calc_rev_depends();
 195
 196   print "SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" .
 197     join("\n", map { $_->{tag} } grep { !scalar @{ $_->{rev_depends} } } values %{ $controls }) .
 198     "\n\n";
 199 }
 200
 201 sub apply_upgrade {
 202   my $name = shift;
 203
 204   my (@order, %tags, @all_tags);
 205
 206   if ($name eq "ALL") {
 207     calc_rev_depends();
 208     @all_tags = map { $_->{tag} } grep { !@{$_->{rev_depends}} } values %{ $controls };
 209
 210   } else {
 211     $form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name});
 212     @all_tags = ($name);
 213   }
 214
 215   foreach my $tag (@all_tags) {
 216     build_upgrade_order($tag, \@order, \%tags);
 217   }
 218
 219   my @upgradescripts = map { $controls->{$_}->{applied} = 0; $controls->{$_} } @order;
 220
 221   my $dbh = $form->dbconnect_noauto(\%myconfig);
 222
 223   $dbh->{PrintWarn}  = 0;
 224   $dbh->{PrintError} = 0;
 225
 226   $user->create_schema_info_table($form, $dbh);
 227
 228   my $query = qq|SELECT tag FROM schema_info|;
 229   $sth = $dbh->prepare($query);
 230   $sth->execute() || $form->dberror($query);
 231   while (($tag) = $sth->fetchrow_array()) {
 232     $controls->{$tag}->{applied} = 1 if defined $controls->{$tag};
 233   }
 234   $sth->finish();
 235
 236   @upgradescripts = sort { $a->{priority} <=> $b->{priority} } grep { !$_->{applied} } @upgradescripts;
 237   if (!@upgradescripts) {
 238     print "The upgrade has already been applied.\n";
 239     exit 0;
 240   }
 241
 242   foreach my $control (@upgradescripts) {
 243     $control->{file} =~ /\.(sql|pl)$/;
 244     my $file_type = $1;
 245
 246     # apply upgrade
 247     print "Applying upgrade $control->{file}\n";
 248
 249     if ($file_type eq "sql") {
 250       $user->process_query($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 251     } else {
 252       $user->process_perl_script($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 253     }
 254   }
 255
 256   $dbh->disconnect();
 257 }
 258
 259 sub build_upgrade_order {
 260   my $name  = shift;
 261   my $order = shift;
 262   my $tag   = shift;
 263
 264   my $control = $controls->{$name};
 265
 266   foreach my $dependency (@{ $control->{depends} }) {
 267     next if $tags->{$dependency};
 268     $tags->{$dependency} = 1;
 269     build_upgrade_order($dependency, $order, $tag);
 270   }
 271
 272   push @{ $order }, $name;
 273   $tags->{$name} = 1;
 274 }
 275
 276 #######
 277 #######
 278 #######
 279
 280 eval { require "config/lx-erp.conf"; };
 281 eval { require "config/lx-erp-local.conf"; } if (-f "config/lx-erp-local.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 show_help() if ($opt_help);
 301
 302 $controls = parse_dbupdate_controls($form, "Pg");
 303
 304 dump_list()                  if ($opt_list);
 305 dump_tree()                  if ($opt_tree);
 306 dump_tree_reverse()          if ($opt_rtree);
 307 dump_graphviz($opt_graphviz) if (defined $opt_graphviz);
 308 dump_nodeps()                if ($opt_nodeps);
 309
 310 if ($opt_user) {
 311   my $file_name = "users/${opt_user}.conf";
 312
 313   eval { require($file_name); };
 314   $form->error("File '$file_name' was not found") if $@;
 315   $locale = new Locale($myconfig{countrycode}, "all");
 316   $user = new User("users/members", $opt_user);
 317   map { $form->{$_} = $myconfig{$_} } keys %myconfig;
 318 }
 319
 320 if ($opt_apply) {
 321   $form->error("--apply used but no configuration file given with --user.") if (!$user);
 322   apply_upgrade($opt_apply);
 323 }