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::Auth;
  24 use SL::Form;
  25 use SL::User;
  26 use SL::Locale;
  27 use SL::DBUpgrade2;
  28 use SL::DBUtils;
  29
  30 #######
  31 #######
  32 #######
  33
  34 my ($opt_list, $opt_tree, $opt_rtree, $opt_nodeps, $opt_graphviz, $opt_help);
  35 my ($opt_user, $opt_apply);
  36
  37 our (%myconfig, $form, $user, $auth);
  38
  39 sub show_help {
  40   my $help_text = <<'END_HELP'
  41 dbupgrade2_tool.pl [options]
  42
  43   A validation and information tool for the database upgrade scripts
  44   in 'sql/Pg-upgrade2'.
  45
  46   At startup dbupgrade2_tool.pl will always check the consistency
  47   of all database upgrade scripts (e.g. circular references, invalid
  48   formats, missing meta information). You can but don't have to specifiy
  49   additional actions.
  50
  51   Actions:
  52     --list               Lists all database upgrade tags
  53     --tree               Lists all database upgrades in tree form
  54     --rtree              Lists all database upgrades in reverse tree form
  55     --graphviz[=file]    Create a Postscript document showing a tree of
  56                          all database upgrades and their dependencies.
  57                          If no file name is given then the output is
  58                          written to 'db_dependencies.ps'.
  59     --nodeps             List all database upgrades that no other upgrade
  60                          depends on
  61     --apply=tag          Applies the database upgrades 'tag' and all
  62                          upgrades it depends on. If '--apply' is used
  63                          then the option '--user' must be used as well.
  64     --help               Show this help and exit.
  65
  66   Options:
  67     --user=name          The name of the user configuration to use for
  68                          database connectivity.
  69 END_HELP
  70     ;
  71
  72   # Syntax-Highlighting-Fix für Emacs: '
  73
  74   print $help_text;
  75
  76   exit 0;
  77 }
  78
  79 sub error {
  80 }
  81
  82 sub calc_rev_depends {
  83   map { $_->{rev_depends} = []; } values %{ $controls };
  84
  85   foreach my $control (values %{ $controls }) {
  86     map { push @{ $controls->{$_}->{rev_depends} }, $control->{tag} } @{ $control->{depends} };
  87   }
  88 }
  89
  90 sub dump_list {
  91   my @sorted_controls = sort_dbupdate_controls($controls);
  92
  93   print "LIST VIEW\n\n" .
  94     "number tag depth priority\n";
  95
  96   $i = 0;
  97   foreach (@sorted_controls) {
  98     print "$i $_->{tag} $_->{depth} $_->{priority}\n";
  99     $i++;
 100   }
 101
 102   print "\n";
 103 }
 104
 105 sub dump_node {
 106   my ($tag, $depth) = @_;
 107
 108   print " " x $depth . $tag . "\n";
 109
 110   foreach my $dep_tag (@{ $controls->{$tag}->{depends} }) {
 111     dump_node($dep_tag, $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   foreach my $dep_tag (@{ $controls->{$tag}->{rev_depends} }) {
 135     dump_node_reverse($dep_tag, $depth + 1);
 136   }
 137 }
 138
 139 sub dump_tree_reverse {
 140   print "REVERSE TREE VIEW\n\n";
 141
 142   calc_rev_depends();
 143
 144   my @sorted_controls = sort_dbupdate_controls($controls);
 145
 146   foreach my $control (@sorted_controls) {
 147     last if ($control->{depth} > 1);
 148     dump_node_reverse($control->{tag}, "");
 149   }
 150
 151   print "\n";
 152 }
 153
 154 sub dump_graphviz {
 155   my $file_name = shift || "db_dependencies.ps";
 156
 157   print "GRAPHVIZ POSTCRIPT\n\n";
 158   print "Output will be written to '${file_name}'\n";
 159
 160   calc_rev_depends();
 161
 162   $dot = "|dot -Tps ";
 163   open OUT, "${dot}> \"${file_name}\"" || die;
 164
 165   print OUT
 166     "digraph db_dependencies {\n" .
 167     "node [shape=box style=filled fillcolor=white];\n";
 168
 169   my %ranks;
 170   foreach my $c (values %{ $controls }) {
 171     $ranks{$c->{depth}} ||= [];
 172
 173     my ($pre, $post) = ('node [fillcolor=lightgray] ', 'node [fillcolor=white] ') if (!scalar @{ $c->{rev_depends} });
 174
 175     push @{ $ranks{$c->{"depth"}} }, qq|${pre}"$c->{tag}"; ${post}|;
 176   }
 177
 178   foreach (sort keys %ranks) {
 179     print OUT "{ rank = same; ", join("", @{ $ranks{$_} }), " }\n";
 180   }
 181
 182   foreach my $c (values %{ $controls }) {
 183     print OUT "$c->{tag};\n";
 184
 185     foreach my $d (@{ $c->{depends} }) {
 186       print OUT "$c->{tag} -> $d;\n";
 187     }
 188   }
 189
 190   print OUT "}\n";
 191   close OUT;
 192 }
 193
 194 sub dump_nodeps {
 195   calc_rev_depends();
 196
 197   print "SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" .
 198     join("\n", map { $_->{tag} } grep { !scalar @{ $_->{rev_depends} } } 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 "config/lx-erp.conf"; };
 282 eval { require "config/lx-erp-local.conf"; } if (-f "config/lx-erp-local.conf");
 283
 284 $form = Form->new();
 285 $locale = Locale->new("de", "login");
 286
 287 #######
 288 #######
 289 #######
 290
 291 GetOptions("list"       => \$opt_list,
 292            "tree"       => \$opt_tree,
 293            "rtree"      => \$opt_rtree,
 294            "nodeps"     => \$opt_nodeps,
 295            "graphviz:s" => \$opt_graphviz,
 296            "user=s"     => \$opt_user,
 297            "apply=s"    => \$opt_apply,
 298            "help"       => \$opt_help,
 299   );
 300
 301 show_help() if ($opt_help);
 302
 303 $controls = parse_dbupdate_controls($form, "Pg");
 304
 305 dump_list()                  if ($opt_list);
 306 dump_tree()                  if ($opt_tree);
 307 dump_tree_reverse()          if ($opt_rtree);
 308 dump_graphviz($opt_graphviz) if (defined $opt_graphviz);
 309 dump_nodeps()                if ($opt_nodeps);
 310
 311 if ($opt_user) {
 312   $auth = SL::Auth->new();
 313   if (!$auth->session_tables_present()) {
 314     $form->error("The session and user management tables are not present in the " .
 315                  "authentication database. Please use the administration web interface " .
 316                  "and to create them.");
 317   }
 318
 319   %myconfig = $auth->read_user($opt_user);
 320
 321   if (!$myconfig{login}) {
 322     $form->error($form->format_string("The user '#1' does not exist.", $opt_user));
 323   }
 324
 325   $locale = new Locale($myconfig{countrycode}, "all");
 326   $user   = new User($opt_user);
 327
 328   map { $form->{$_} = $myconfig{$_} } keys %myconfig;
 329 }
 330
 331 if ($opt_apply) {
 332   $form->error("--apply used but no configuration file given with --user.") if (!$user);
 333   apply_upgrade($opt_apply);
 334 }