stategraph.in 10.3 KB
Newer Older
1 2 3
#!/usr/bin/perl -w

#
4
# Copyright (c) 2000-2013 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
24 25 26 27 28
#

use lib '@prefix@/lib';
use libdb;

29 30 31
# Turn off line buffering
$| = 1;

32 33
sub doformats($$);

34 35
my $datetag = `date +%Y%m%d%H%M%S`;
chomp($datetag);
36
my $date = &localtime();
37 38
$date =~ s/[ \t]+/ /;
$date =~ s/\n//;
39
my $defprefix = "stategraph";
40 41 42 43
my $prefix = $defprefix;
my $v = 0; # Verbose
my $help=0;
my $allmodes=1;
44
my $x=0;
45 46
my $g=0;
my $t=0;
47
my %modes=();
48 49
my $dot=0;
my $vcg=0;
50 51 52
my $ps=0;
my $gif=0;
my $png=0;
53 54 55

while ($_ = shift) {
    print "arg: '$_'\n" if ($v);
56 57
    # Ordering: Make sure longer options are first where the first char is
    # ambiguous.
58
    /^-h/ && do { $help=1; next; };
59 60
    /^-dot/ && do { $dot=1; next; };
    /^-vcg/ && do { $vcg=1; next; };
61 62 63
    /^-ps/ && do { $ps=1; next; };
    /^-gif/ && do { $gif=1; next; };
    /^-png/ && do { $png=1; next; };
64
    /^-[dv]/ && do { $v++; next; };
65
    /^-x/ && do { $x=1; next; };
66 67
    /^-g/ && do { $g=1; next; };
    /^-t/ && do { $t=1; next; };
68 69 70 71 72 73 74 75
    /^-o/ && do { $prefix=shift || $defprefix; next; };
    # if it is all lowercase, caps it, otherwise leave it alone
    if ("\L$_" eq "$_") { $_ = "\U$_"; }
    $modes{$_}=1;
    $allmodes=0;
    print "mode '$_' added.\n" if ($v);
}

76 77
if ($allmodes && $x) { $x=0; }

78 79 80
if ($help) {
    #Help mode
    print <<EOF;
81
Usage: stategraph [-h] [-v] [-d] [-dot] [-vcg] [-x] [-g] [-t]
82
                  [-ps] [-gif] [-png] [-o <out>] [op_mode1] ...
83 84 85
  -h       This help message
  -v       Verbose mode. Multiple -v options cause more verbosity.
  -d       Debug mode. Alias for -v.
86 87
  -dot     Generate output using 'dot' graph layout tool.
  -vcg     Generate output using 'vcg' graph layout tool.
88 89 90
  -x       Exclude all op_modes not explicitly included
  -g       Use global layout instead of clustered
  -t       Supress transition labels
91 92 93
  -ps      Generate PostScript format output.
  -gif     Generate GIF format output.
  -png     Generate PNG format output.
94 95 96 97 98
  -o <out> Prefix for output filenames.

This program generates a graph of the state machines as defined in the
state_transitions and mode_transitions tables in the database. This
graph is generated from the current in the actual database, and is
99 100 101 102 103 104 105 106
always current. The -dot and -vcg options determine the layout tool(s)
used for generating the graphs. The -ps, -gif, and -png options 
determine the format of the output images. If no layout options are 
given, dot will be used. If no format options are given, ps will be used.
Output will be saved into <out>.{ps|gif|png}, depending on the format(s)
requested. When both -dot and -vcg are specified, output will be in 
<out>-{dot,vcg}.{ps|gif|png}. When -o is not given, <out> defaults to 
'$defprefix'. If an output file exists, it will be overwritten.
107 108 109 110 111 112 113 114
stategraph will show state machine diagrams for all operational modes
by default, or for a subset by specifying the desired modes on the
command line.
EOF

    die("\n");
}

115 116
my $vcgtag="-vcg";
my $dottag="-dot";
117
my $cleanup=!$v;
118
my $nocluster=$g;
119
if (!$dot && !$vcg) { $dot=1; }
120
if (!$ps && !$gif && !$png) { $ps=1; }
121
if (!($dot && $vcg)) { $vcgtag=""; $dottag=""; }
122 123 124
my $filename="/tmp/stategraph-vcg-$$";
my $filename2="/tmp/stategraph-dot-$$";

125 126 127 128 129 130 131 132
if ($vcg) {
    open(TMP,">$filename");
    print TMP "graph: {\n  orientation: top_to_bottom\n".
      "  title: \"Testbed State Machines Graph - ".$date."\"\n";
    print TMP "  height: 500\n  width: 1000\n";
    print TMP "  priority_phase: yes\n  straight_phase: yes\n";
    print TMP "  arrowmode: fixed\n  node. shape:ellipse\n";
    print TMP "  layoutalgorithm: maxdegree\n  port_sharing: no\n";
133
    print TMP "  display_edge_labels: yes\n  splines: yes\n";
134
    # Use one of the following to control layout... whichever works better...
135 136
    print TMP "  crossingweight: medianbary\n";
    #print TMP "  crossingweight: barymedian\n";
137
}
138

139 140
if ($dot) {
    open(TMPN,">$filename2");
141 142 143 144 145
    if (!$nocluster) {
	print TMPN "digraph StateGraph {\n  node [shape=ellipse]\n  edge [fontsize=8]\n";
    } else {
	print TMPN "digraph StateGraph {\n  node [shape=ellipse]\n  edge [fontsize=8]\n  graph [clusterrank=global]\n";
    }
146
    #print TMPN "digraph StateGraph {\n  node [shape=ellipse]\n";
147
}
148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163

my %states=();

my $cmd1 = "select * from state_transitions order by op_mode,state1,state2;";
my $cmd2 = "select * from mode_transitions order by op_mode1,state1,".
  "op_mode2,state2;";
my $lastmode="";
my $delim="_";

my $result = DBQueryFatal($cmd1);
while(@r=$result->fetchrow()) {
    $m=$r[0];
    print "mode='$m' lastmode='$lastmode'\n" if ($v>1);
    if (!($allmodes || (defined($modes{$m}) && $modes{$m}))) { next; }
    print "mode $m is on the list\n" if ($v && !$allmodes);
    if ($m ne $lastmode) {
164 165
	if ($lastmode ne "") { print TMPN "  }\n"if $dot; }
	print TMPN "  subgraph cluster_$m {\n    label = \"$m\";\n" if $dot;
166
	#print TMPN "  subgraph cluster_$m {\n    rank=max\n    label = \"$m\";\n" if $dot;
167 168 169 170 171
	#print "Starting subgraph $m\n";
    }
    $lastmode = $m;
    $s1=$r[1];
    $s2=$r[2];
172
    $l =$r[3];
173 174 175
    mkstates([$m,$s1],[$m,$s2]);
    $n1 = $m.$delim.$s1;
    $n2 = $m.$delim.$s2;
176 177 178 179 180 181 182 183 184
    #if ($n1 ne $n2) {
	#print TMPN "    $n1 -> $n2;\n" if $dot;
	#print TMPN "    $n1 -> $n2 [sametail=\"tail$n2\",samehead=\"head$n1\"];\n" if $dot;
	#print TMPN "    $n1 -> $n2 [sametail=\"tail$n1\",samehead=\"head$n2\"];\n" if $dot;
	#print TMPN "    $n1 -> $n2 [sametail=\"$n2\"];\n" if $dot;
	#print TMPN "    $n1 -> $n2 [sametail=\"$n1\"];\n" if $dot;
	#print TMPN "    $n1 -> $n2 [samehead=\"$n1\"];\n" if $dot;
	#print TMPN "    $n1 -> $n2 [samehead=\"$n2\"];\n" if $dot;
    #} else {
185 186 187 188 189
        if ($t) {
	    print TMPN "    $n1 -> $n2;\n" if $dot;
	} else {
	    print TMPN "    $n1 -> $n2 [label=\"$l\"];\n" if $dot;
	}
190
    #}
191
    print TMP "  edge: { sourcename: \"$n1\" targetname: \"$n2\" }\n" if $vcg;
192 193
}

194
print TMPN "  }\n" if $dot; # end the last subgraph
195 196
my $modetrans=1;

197
%modelist=();
198 199 200 201 202 203 204
$result = DBQueryFatal($cmd2);
while(@r=$result->fetchrow()) {
    $m1=$r[0];
    $s1=$r[1];
    $m2=$r[2];
    $s2=$r[3];
    print "Checking mode transition ($m1, $s1) -> ($m2, $s2)\n" if ($v);
205 206 207 208 209 210 211 212 213 214
    if ($x) {
	# $x and $allmodes are mutually exclusive
	if (!( (defined($modes{$m1}) && $modes{$m1}) &&
	       (defined($modes{$m2}) && $modes{$m2}))) { next; }
	print "mode $m1 and $m2 are both on the list\n" if ($v);
    } else {
	if (!( $allmodes || (defined($modes{$m1}) && $modes{$m1}) ||
	       (defined($modes{$m2}) && $modes{$m2}))) { next; }
	print "mode $m1 or $m2 is on the list\n" if ($v && !$allmodes);
    }
215 216 217
    mkstates([$m1,$s1],[$m2,$s2]);
    $n1=$m1.$delim.$s1;
    $n2=$m2.$delim.$s2;
218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235
    if (0) {
	if (!defined($modelist{"in$n1"})) {
	    print TMPN "  $n1 -> MODE_CHANGE;\n" if $dot;
	    $modelist{"in$n1"}=1;
	}
	if (!defined($modelist{"out$n2"})) {
	    print TMPN "  MODE_CHANGE -> $n2;\n" if $dot;
	    $modelist{"out$n2"}=1;
	}
    } else {
	print TMPN "  $n1 -> $n2;\n" if $dot;
    }
    #print TMPN "  $n1 -> $n2 [samehead=\"$n2\",sametail=\"$n1\"];\n" if $dot;
    #print TMPN "  $n1 -> $n2 [samehead=\"$n1\",sametail=\"$n2\"];\n" if $dot;
    #print TMPN "  $n1 -> $n2 [samehead=\"$n2\"];\n" if $dot;
    #print TMPN "  $n1 -> $n2 [samehead=\"$n1\"];\n" if $dot;
    #print TMPN "  $n1 -> $n2 [sametail=\"$n1\"];\n" if $dot;
    #print TMPN "  $n1 -> $n2 [sametail=\"$n2\"];\n" if $dot;
236
    print TMP "  edge: { sourcename: \"$n1\" targetname: \"$n2\" }\n" if $vcg;
237 238
}

239 240 241
if ($vcg) {
    print TMP "}\n";
    close TMP;
242 243 244 245 246
    print "Generating vcg graphs: ";
    if (-e "$filename.ps") { system("rm $filename.ps"); }
    system("/usr/X11R6/bin/xvcg -silent -psoutput $filename.ps $filename");
    doformats("$filename.ps","$prefix$vcgtag");
    print "\n";
247 248 249 250
}
if ($dot) {
    print TMPN "}\n";
    close TMPN;
251 252 253 254
    print "Generating dot graph: ";
    system("/usr/local/bin/dot -Tps -o $filename2.ps $filename2");
    doformats("$filename2.ps","$prefix$dottag");
    print "\n";
255
}
256 257
print "Done.\n";

258 259 260 261 262 263 264 265 266 267 268 269 270 271
if ($cleanup && $vcg) {
    system("/bin/rm $filename");
    system("/bin/rm $filename.ps");
}
if ($cleanup && $dot) {
    system("/bin/rm $filename2");
    system("/bin/rm $filename2.ps");
}

exit(0);

# * stategraph: add options for making png/gif output via pstopnm,
#   pnmtopng, and ppmtogif

272
sub doformats($$) {
273 274 275 276 277 278
    my ($in,$out) = @_;
    if ($ps) {
	print "ps ";
	system("cp $in $out.ps");
    }
    if (!($gif || $png)) { return; }
279 280 281 282 283 284 285 286
    my $opt = "-stdout -xborder 0 -yborder 0 ";
    my $box = `grep %%BoundingBox $in`;
    if ($box =~ /%%BoundingBox:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/) {
	my ($xmin,$ymin,$xmax,$ymax) = ($1, $2, $3, $4);
	my $xsize=$xmax-$xmin;
	my $ysize=$ymax-$ymin;
	$opt .="-xsize $xsize -ysize $ysize";
    }
287 288
    system("pstopnm $opt $in > $in.ppm 2> /dev/null") &&
      warn("\npstopnm failed: $!\n");
289 290
    if ($gif) {
	print "gif ";
291 292
	system("ppmtogif $in.ppm > $out.gif 2> /dev/null") &&
	  warn("\nppmtogif failed: $!\n");
293 294 295
    }
    if ($png) {
	print "png ";
296 297
	system("pnmtopng $in.ppm > $out.png 2> /dev/null") &&
	  warn("\npnmtopng failed: $!\n");
298 299 300 301 302
    }
    # The ppm is only a temp file, so clean it up
    # Later we could add a ppm output option if anyone cared...
    system("rm $in.ppm") if $cleanup;
}
303 304

sub mkstates {
305 306
    my $n;
    my $l;
307 308 309 310 311 312 313 314 315 316 317
    foreach $pair (@_) {
	my ($m, $s) = @$pair;
	$n = $m.$delim.$s;
	$l = $m."\n".$s;
	if (!defined($states{$n})) {
	    if ($modetrans) {
		# if we're doing modes and it isn't made yet, we don't
		# have a cluster for it, so label it better for TMPN
		$s=$m."\\n".$s;
	    }
	    print "Adding node '$n'\n" if ($v);
318
	    print TMP "  node: { title: \"$n\" label: \"$l\"}\n" if $vcg;
319 320 321 322 323
	    if (!$nocluster) {
		print TMPN "    $n [label=\"$s\"];\n" if $dot;
	    } else {
		print TMPN "    $n [label=\"$m\\n$s\"];\n" if $dot;
	    }
324
	    #print TMPN "    $n;\n" if $dot;
325 326 327 328
	    $states{$n}=1;
	}
    }
}