template_graph.in 9.24 KB
Newer Older
1 2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2006, 2007 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{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/>.
# 
# }}}
23 24
#
use English;
25
use strict;
26
use Getopt::Std;
27
use HTML::Entities;
28 29 30 31 32 33 34

#
# Quickie graph layout.
#
sub usage()
{
    print(STDERR
35
	  "Usage: template_graph [-a] <guid>\n".
36
	  "switches and arguments:\n".
37
	  "-a          - Show all templates (ignore hidden bit)\n".
38 39 40 41
	  "-p <prefix> - prefix for output files.\n".
	  "<guid>      - GUID to graph\n");
    exit(-1);
}
42
my $optlist	 = "p:z:ds";
43
my %options      = ();
44
my $debug	 = 0;
45
my $silent	 = 0;
46
my $prefix       = "/tmp/dot$$";
47 48
my $scale        = 1.0;
my $zoom;
49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
my $guid;

#
# Configure variables
#
my $TB		= "@prefix@";
my $EVENTSYS	= @EVENTSYS@;
my $TBOPS	= "@TBOPSEMAIL@";
my $TBLOGS	= "@TBLOGSEMAIL@";
my $TBDOCBASE	= "@TBDOCBASE@";
my $TBBASE	= "@TBBASE@";
my $CONTROL	= "@USERNODE@";

# Protos
sub ParseArgs();
64
sub SetParent($@);
65 66 67 68 69 70 71 72 73 74 75 76

# Locals
my $DOT         = "/usr/local/bin/dot";
my %versions    = ();

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use libtblog;
77
use Template;
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112

# Be careful not to exit on transient error
$libdb::DBQUERY_MAXTRIES = 0;

#
# Turn off line buffering on output
#
$| = 1;

#
# Set umask for start/swap. We want other members in the project to be
# able to swap/end experiments, so the log and intermediate files need
# to be 664 since some are opened for append.
#
umask(0002);

#
# Untaint the path
#
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

# Now parse arguments.
ParseArgs();

# After parsing args.
my $dotfile	= "$prefix.dot";
my $imapfile	= "$prefix.imap";
my $giffile	= "$prefix.gif";

#
# Grab all the parent pointers.
#
my $query_result =
113
    DBQueryFatal("select vers,parent_vers,hidden,tid,description ".
114
		 "  from experiment_templates ".
115 116 117
		 "where guid='$guid' ".
		 "order by vers");

118 119 120 121 122 123 124 125 126 127 128 129
#
# If nothing left, remove the graph entry.
#
if (! $query_result->num_rows) {
    print "Clearing graph entry for template $guid ...\n";
    
    DBQueryFatal("delete from experiment_template_graphs ".
		 "where parent_guid='$guid'");
    exit(0);
}

#
130
# Build up lists of children (and associated stuff like hidden,description).
131 132 133 134
#
my %hidden	= ();
my %tids        = ();
my %children    = ();
135
my %parents     = ();
136
my %descriptions= ();
137 138
my $rootnode    = 1;	# XXX

139
while (my ($vers,$parent_vers,$hidden,$tid,$description) =
140
       $query_result->fetchrow_array()) {
141 142 143
    $tids{$vers}         = $tid;
    $hidden{$vers}       = $hidden;
    $descriptions{$vers} = $description;
144 145 146 147 148 149 150 151 152 153

    next
	if (!defined($parent_vers));

    $children{$parent_vers} = []
	if (!exists($children{$parent_vers}));
    push(@{ $children{$parent_vers} }, $vers);
}

#
154 155
# We overload the hidden bit on the root template. If its set, that means
# to hide hidden templates, otherwise it means to show hidden templates.
156
#
157 158
my $showall = ($hidden{$rootnode} == 0);
$hidden{$rootnode} = 0;
159

160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
# Defaults;
my $size     = 8;
my $fontsize = 10;
my $bwidth   = 0.75;
my $bheight  = 0.25;
my $arrowsize= 0.7;
my $nodesep  = 0.25;
my $ranksep  = 0.50;

#
# Grab the current scale so we know what to do.
#
$query_result =
    DBQueryFatal("select scale from experiment_template_graphs ".
		 "where parent_guid='$guid'");

176 177
my $curscale = ($query_result->num_rows ?
		($query_result->fetchrow_array())[0] : 1);
178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198

#
# Change scale if zooming and then recalc the defaults.
#
if (defined($zoom)) {
    if ($zoom eq "in") {
	$scale = $curscale * 1.25;
    }
    else {
	$scale = $curscale / 1.25;
    }
}
else {
    $scale = $curscale;
}
$bwidth    = $bwidth  * $scale;
$bheight   = $bheight * $scale;
$arrowsize = $arrowsize * $scale;
$nodesep   = $nodesep * $scale;
$ranksep   = $ranksep * $scale;

199
open(DOT, "> $dotfile") or
200
    tbdie("Could not open $dotfile!");
201 202

print DOT "digraph TemplateGraph {\n";
203 204 205
print DOT "  rankdir=\"LR\"\n";
print DOT "  nodesep=$nodesep\n";
print DOT "  ranksep=$ranksep\n";
206
print DOT "  fontname=\"Courier\"\n";
207 208 209
print DOT "  node [shape=rectangle,fontsize=$fontsize,".
            "height=$bheight,width=$bwidth,fixedsize=true]\n";
print DOT "  edge [arrowsize=$arrowsize]\n";
210 211 212
print DOT "  subgraph guid {\n";
print DOT "    label = \"$guid\";\n";

213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236
#
# Do a recursive decent to figure out the parent for each template.
# We do this cause we want to skip hidden templates, but pick it up
# again down the line when hidden=0.
#
sub SetParent($@)
{
    my ($parent, @kids) = @_;

    foreach my $kid (@kids) {
	if (!$showall && $hidden{$kid}) {
	    # pass our parent to children, thereby skipping a level.
	    SetParent($parent, @{ $children{$kid} })
		if (exists($children{$kid}));
	}
	else {
	    $parents{$kid} = $parent;
	    SetParent($kid, @{ $children{$kid} })
		if (exists($children{$kid}));
	}
    }
}
$parents{$rootnode} = undef;
SetParent($rootnode, @{ $children{$rootnode} });
237

238 239 240 241 242 243 244
#
# The parents hash now has all the templates that are visible. 
#
foreach my $kid (sort {$a <=> $b} keys(%parents)) {
    my $vers   = $kid;
    my $parent = $parents{$vers};
    my $tid    = $tids{$vers};
245 246
    my $url    = "$TBBASE/template_show.php".
	           "?show=graph&guid=$guid&version=$vers";
247
    my $color  = "black";
248

249 250
    print DOT "    $parent -> $kid;\n"
	if (defined($parent));
251

252 253 254 255 256 257 258
    # Shorten the description
    my $description = $descriptions{$vers};
    if (length($description) > 50) {
	$description = substr($description, 0, 50) . " <b>...</b>";
    }

    # Encode to avoid confusing things.
259
    $description = encode_entities($description, '\'\r\n');
260 261
    $description = encode_entities($description);

262 263 264 265 266 267
    my $query_result =
	DBQueryFatal("select name,value from experiment_template_parameters ".
		     "where parent_guid='$guid' and parent_vers='$vers'");

    my $table = "<table cellpadding=0 cellspacing=0 border=0> ".
	"<tr><td>Version:</td><td>$vers</td></tr>".
268 269
	"<tr><td>TID:</td><td>$tid</td></tr>".
        "<tr><td>Description:</td><td>$description</td></tr>";
270 271 272

    if ($query_result->num_rows) {
	$table .= "<tr><td>Parameters:</td>".
273
	    "<td><table cellpadding=0 cellspacing=0 border=1>";
274 275

	while (my ($name, $value) = $query_result->fetchrow_array()) {
276
	    $table .= "<tr><td>${name}:</td><td>$value</td></tr>";
277 278 279 280 281 282
	}
	$table .= "</table></td>";
    }

    $table .= "</table>";
	
283
    my $tooltip = "return escape(\'$table\');";
284 285 286 287 288 289 290 291 292 293 294 295

    #
    # Figure out a point size that makes the label fit inside. We do not
    # want to go too big of course.
    #
    # Target labelwidth is 80% of the box, converted to points.
    my $labelwidth = ($bwidth * 0.80) / 0.0139;

    # And the fontsize ... I made this up.
    my $fontsize   = int((($labelwidth / length($tid)) * 1.8) + 0.5);

    # But we do not want the font arbitrarily large.
296 297
    $fontsize = 12
	if ($fontsize > 12);
298 299
    $color = "blue"
	if ($hidden{$vers});
300 301
	
    if (!exists($versions{"$vers"})) {
302
	print DOT "    $vers [fontsize=$fontsize,color=$color,".
303
	    "label=\"$tid\",href=\"$url\",tooltip=\"$tooltip\"];\n";
304 305 306 307 308 309 310 311 312 313
	$versions{"$vers"} = $vers;
    }
}
print DOT "  }\n";
print DOT "}\n";
close(DOT);

#
# Now run dot and generate both a gif and an image map file.
#
314 315 316 317
my $redirect = ($silent ? "> /dev/null 2>&1" : "");

system("$DOT -Tgif -o $giffile $dotfile $redirect");
system("$DOT -Tcmapx -o $imapfile $dotfile $redirect");
318 319 320 321 322 323 324

#
# Grab the input data. 
#
my $gifdata = `cat $giffile`;
my $imapdata = `cat $imapfile`;

325 326 327 328
#
# Massage the mapfile; tooltips --> onmouseovers
#
$imapdata =~ s/title=/onmouseover=/g;
329
$imapdata =~ s/version=(\d*)\"/version=$1\" id=Tarea${1}/g;
330

331
#print "$imapdata\n";
332

333 334 335 336 337
$gifdata = DBQuoteSpecial($gifdata);
$imapdata = DBQuoteSpecial($imapdata);

DBQueryFatal("replace into experiment_template_graphs set ".
	     "    parent_guid='$guid', ".
338
	     "    scale='$scale', ".
339 340 341
	     "    image=$gifdata, ".
	     "    imap=$imapdata");

342 343
unlink($dotfile, $giffile, $imapfile)
    if (!$debug);
344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380
exit(0);

#
# Parse command arguments. Once we return from getopts, all that are
# left are the required arguments.
#
sub ParseArgs()
{
    if (! getopts($optlist, \%options)) {
	usage();
    }

    if (@ARGV != 1) {
	usage();
    }
    #
    # Pick up guid and untaint.
    #
    my $tmp = shift(@ARGV);

    if ($tmp =~ /^([\w]*)$/) {
	$guid = $1;
    }
    else {
	tbdie("Bad data in argument: $tmp");
    }

    if (defined($options{"p"})) {
	$prefix = $options{"p"};

	if ($prefix =~ /^([-\w\.\/]*)$/) {
	    $prefix = $1;
	}
	else {
	    tbdie("Bad data in argument: $prefix");
	}
    }
381 382
    if (defined($options{"d"})) {
	$debug = 1;
383
    }
384 385 386
    if (defined($options{"s"})) {
	$silent = 1;
    }
387 388 389 390 391 392 393
    if (defined($options{"z"})) {
	$zoom = $options{"z"};

	if ($zoom ne "in" && $zoom ne "out") {
	    die("Improper zoom request: $zoom!\n");
	}
    }
394
}