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     "graph [size=\"16.53,11.69!\"];\n" .
 168     "node [shape=box style=filled fillcolor=white];\n";
 169
 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 (!scalar @{ $c->{rev_depends} });
 175
 176     push @{ $ranks{$c->{"depth"}} }, qq|${pre}"$c->{tag}"; ${post}|;
 177   }
 178
 179   foreach (sort keys %ranks) {
 180     print OUT "{ rank = same; ", join("", @{ $ranks{$_} }), " }\n";
 181   }
 182
 183   foreach my $c (values %{ $controls }) {
 184     print OUT "$c->{tag};\n";
 185
 186     foreach my $d (@{ $c->{depends} }) {
 187       print OUT "$c->{tag} -> $d;\n";
 188     }
 189   }
 190
 191   print OUT "}\n";
 192   close OUT;
 193 }
 194
 195 sub dump_nodeps {
 196   calc_rev_depends();
 197
 198   print "SCRIPTS NO OTHER SCRIPTS DEPEND ON\n\n" .
 199     join("\n", map { $_->{tag} } grep { !scalar @{ $_->{rev_depends} } } values %{ $controls }) .
 200     "\n\n";
 201 }
 202
 203 sub apply_upgrade {
 204   my $name = shift;
 205
 206   my (@order, %tags, @all_tags);
 207
 208   if ($name eq "ALL") {
 209     calc_rev_depends();
 210     @all_tags = map { $_->{tag} } grep { !@{$_->{rev_depends}} } values %{ $controls };
 211
 212   } else {
 213     $form->error("Unknown dbupgrade tag '$name'") if (!$controls->{$name});
 214     @all_tags = ($name);
 215   }
 216
 217   foreach my $tag (@all_tags) {
 218     build_upgrade_order($tag, \@order, \%tags);
 219   }
 220
 221   my @upgradescripts = map { $controls->{$_}->{applied} = 0; $controls->{$_} } @order;
 222
 223   my $dbh = $form->dbconnect_noauto(\%myconfig);
 224
 225   $dbh->{PrintWarn}  = 0;
 226   $dbh->{PrintError} = 0;
 227
 228   $user->create_schema_info_table($form, $dbh);
 229
 230   my $query = qq|SELECT tag FROM schema_info|;
 231   $sth = $dbh->prepare($query);
 232   $sth->execute() || $form->dberror($query);
 233   while (($tag) = $sth->fetchrow_array()) {
 234     $controls->{$tag}->{applied} = 1 if defined $controls->{$tag};
 235   }
 236   $sth->finish();
 237
 238   @upgradescripts = sort { $a->{priority} <=> $b->{priority} } grep { !$_->{applied} } @upgradescripts;
 239   if (!@upgradescripts) {
 240     print "The upgrade has already been applied.\n";
 241     exit 0;
 242   }
 243
 244   foreach my $control (@upgradescripts) {
 245     $control->{file} =~ /\.(sql|pl)$/;
 246     my $file_type = $1;
 247
 248     # apply upgrade
 249     print "Applying upgrade $control->{file}\n";
 250
 251     if ($file_type eq "sql") {
 252       $user->process_query($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 253     } else {
 254       $user->process_perl_script($form, $dbh, "sql/$form->{dbdriver}-upgrade2/$control->{file}", $control);
 255     }
 256   }
 257
 258   $dbh->disconnect();
 259 }
 260
 261 sub build_upgrade_order {
 262   my $name  = shift;
 263   my $order = shift;
 264   my $tag   = shift;
 265
 266   my $control = $controls->{$name};
 267
 268   foreach my $dependency (@{ $control->{depends} }) {
 269     next if $tags->{$dependency};
 270     $tags->{$dependency} = 1;
 271     build_upgrade_order($dependency, $order, $tag);
 272   }
 273
 274   push @{ $order }, $name;
 275   $tags->{$name} = 1;
 276 }
 277
 278 #######
 279 #######
 280 #######
 281
 282 eval { require "config/lx-erp.conf"; };
 283 eval { require "config/lx-erp-local.conf"; } if (-f "config/lx-erp-local.conf");
 284
 285 $form = Form->new();
 286 $locale = Locale->new("de", "login");
 287
 288 #######
 289 #######
 290 #######
 291
 292 GetOptions("list"       => \$opt_list,
 293            "tree"       => \$opt_tree,
 294            "rtree"      => \$opt_rtree,
 295            "nodeps"     => \$opt_nodeps,
 296            "graphviz:s" => \$opt_graphviz,
 297            "user=s"     => \$opt_user,
 298            "apply=s"    => \$opt_apply,
 299            "help"       => \$opt_help,
 300   );
 301
 302 show_help() if ($opt_help);
 303
 304 $controls = parse_dbupdate_controls($form, "Pg");
 305
 306 dump_list()                  if ($opt_list);
 307 dump_tree()                  if ($opt_tree);
 308 dump_tree_reverse()          if ($opt_rtree);
 309 dump_graphviz($opt_graphviz) if (defined $opt_graphviz);
 310 dump_nodeps()                if ($opt_nodeps);
 311
 312 if ($opt_user) {
 313   $auth = SL::Auth->new();
 314   if (!$auth->session_tables_present()) {
 315     $form->error("The session and user management tables are not present in the " .
 316                  "authentication database. Please use the administration web interface " .
 317                  "and to create them.");
 318   }
 319
 320   %myconfig = $auth->read_user($opt_user);
 321
 322   if (!$myconfig{login}) {
 323     $form->error($form->format_string("The user '#1' does not exist.", $opt_user));
 324   }
 325
 326   $locale = new Locale($myconfig{countrycode}, "all");
 327   $user   = new User($opt_user);
 328
 329   map { $form->{$_} = $myconfig{$_} } keys %myconfig;
 330 }
 331
 332 if ($opt_apply) {
 333   $form->error("--apply used but no configuration file given with --user.") if (!$user);
 334   apply_upgrade($opt_apply);
 335 }