daVinci & JAVA [LONG]

Hi

Those of you working with UNIX and JAVA 1.02 might be interested in the
following perl script. It takes a set of JAVA 1.02 classes and builds a
daVinci TERM tree from them. It colours nodes according to their
package, differentiates between classes and interfaces, and will
store/load a colour map of packages from an auxilary file.

If you are not familier with daVinci, it is a superb free (for non-
commercial use) Tree, DAG, and cyclic graph viewer available from the
University of Bremen.
<URL:HTTP://www.informatik.uni-bremen.de/~davinci/>

The best options for viewing the resultant graph are :
Layout/Orientation/Left to Right
Options/Layout Algorithm/Quality = 5
Options/Layout Algorithm/Keep Nodes At Levels = OFF

I've found it extremely useful when dealing with my Jigsaw extensions.
(Just to validate my posting this to this list ! ;-) ----^)

Joel
-- 
Joel.Crisp@bris.ac.uk | ets-webmaster@bris.ac.uk  | "I remember Babylon" -
Software Engineer, Institute for Learning and     |        Arthur C Clarke
Research Technology, University of Bristol, UK    |
http://www.ets.bris.ac.uk/                        |

#!/usr/local/bin/perl

# $Id: java2davinci,v 1.2 1997/01/14 15:55:19 joel Exp $

# Quick hack to draw JAVA class diagrams from compiled JAVA files.
# All JAVA files must be .class and all referenced classes must be in 
# CLASSPATH. Uses javap, so javap must be in the path.

# Usage : java2davinci -p <full package name> [classfile] [classfile] ....
# Other options :
#    -q supresses progress output, error output is to stderr.
#    -i <package> ignores all class files in <package>
#    -m <file> load package colours from <file>
#    -d <file> dump package colours to <file>

# Typically :
# wip/JAVA-$> java2davinci -p UK.ac.bris.ilrt `find . -name \*.class -print` 

$quiet=0;
%ignore=();
%parsed=();
%nodes=();
%edges=();
%interfacep=();
%packages=();
@colours=( 'white', 'red', 'green', 'blue', 'grey', 'yellow', 'brown', 'pink', 'orange', 'darkgrey' , 'darkred', 'khaki', 'azure3' ,'cyan');
$cnum=0;
@stack=();
$id=0;
$usedump=0;

$tpackage="UK.ac.bris.ilrt";

while( $classfile = shift (@ARGV)) {
    if($classfile eq "-p" ) {
	$tpackage=shift @ARGV;
	next;
    }

    if($classfile eq "-i" ) {
        $package=shift @ARGV; # ignore all classes in package  
	$ignore{$package}=1;
	next;
    }

    if($classfile eq "-q") {
	$quiet=1;
	next;
    }

    if($classfile eq "-m") {
	$file=shift @ARGV;
	open(INFILE,"<$file");
	while(<INFILE>) {
	    @info=split (" ",$_);
	    $colour=$info[1];
	    $packages{$info[0]}=$colour;
	    print STDERR "Loading $info[0] as $colour\n" if ! $quiet; 
	    @colours2=();
	    while($colour2=shift @colours) {
		push(@colours2,$colour2) if($colour2 ne $colour);
	    }
	    @colours=@colours2;
	    @colours2=();
	}
	close INFILE;
    }

    if($classfile eq "-d") {
	$dumpfile=shift @ARGV;
	$usedump=1;
    }

    $classfile=~s#\/#.#g;
    $classfile=~s#\.class##;
    $classfile=~s#^\.\.##;  
    push(@stack,$classfile) if $classfile =~ m/^$tpackage/;
}

while ( $classfile = shift @stack) {
    $classfile=~s#\/#.#g;

    next if exists $parsed{$classfile};
    $package=$classfile;
    $package=~ s/.[^\.]*$//;
    next if exists $ignore{$package};


    print STDERR "Parsing $classfile\n" if (! $quiet);
    $parsed{$classfile} = 1;
    open (INFILE,"javap $classfile|");
    $junk=<INFILE>;
    $classdef=<INFILE>;   
    
    @methods=();
    @vars=();	
    while(<INFILE>) {
	last if $_ eq "}";	 
	if($_ =~ m/(.*)/) {
	    push(@methods,$_);
	} else {
	    push(@vars,$_);
	}
    }
    close INFILE;
    @data=split(" ",$classdef);
    while( $word = shift (@data)) {
	last if($word eq "class" || $word eq "interface") 
	}

    $isinterface=0;
    $isinterface=1 if $word eq "interface";
    $word=shift (@data);
    next if $word eq "";
    $thisclass=$word;
    $thisclass=~ s#/#.#g; # Convert interface classes from /x/y/z to .x.y.z
    $nodes{$thisclass}=$id++ if(! exists $nodes{$thisclass});
    $interfacep{$thisclass}=$isinterface;
    $word=shift (@data); # skip 'Extends'
    next if ($word ne "extends");
    $word = shift @data;
    $package=$word;
    $package=~ s/.[^\.]*$//;
    next if exists $ignore{$package};

#    next if $word eq "java.lang.Object";
    if(! exists $nodes{$word} ) {
	$nodes{$word}=$id++;
	push(@stack,$word);
    }
    my @edges=();
    $edges{$thisclass}=\@edges;
    push ( @edges, $nodes{$word});
    $word=shift @data;
    next if $word ne "implements";
    @interfaces=split(",",(shift @data));
    foreach $interface (@interfaces) {
	next if $interface eq "";
	$package=$interface;
	$package=~ s/.[^\.]*$//;
	next if exists $ignore{$package};
	$interface=~ s#/#.#g; # Convert interface classes from /x/y/z to .x.y.z
	if(! exists $nodes{$interface} ) {
	    $nodes{$interface}=$id++;
	    push(@stack,$interface);
	}
	$interfacep{$interface}=1;
	push (@edges, $nodes{$interface});
    }
}

print STDERR "----\n" if (! $quiet);
print "[";

open(DUMPFILE,">$dumpfile") if $usedump;

%dumped=();

foreach $key (keys %nodes) {
    $name=$key;
    $name =~ s/.*\.([^\.]*)$/$1/;
    $package=$key;
    $package=~ s/\.[^\.]*$//;
    if (! exists $packages{$package} ) {
	$packages{$package}=$colours[$cnum++];
    }
    if( !exists $dumped{$package} ) {
	print STDERR "Package $package is $packages{$package}\n" if(! $quiet);
	print DUMPFILE "$package $packages{$package}\n" if $usedump;
	$dumped{$package}=1;
    }

    print "l(\"$nodes{$key}\",n(\"\",[a(\"OBJECT\",\"$name\")";
    print ",a(\"COLOR\",\"".$packages{$package}."\")";
    print ",a(\"_GO\",\"ellipse\")" if($interfacep{$key});
    print "],[";
    $c=$#{$edges{$key}};
    foreach $edge (@{$edges{$key}}) {
	print "e(\"".$nodes{$key}."->$edge\",[],r(\"$edge\"))";
	$c--;
	print "," if($c>=0);
    }
    print "])),";
}

close DUMPFILE if $usedump;

foreach $package (keys %packages) {
    print "l(\"$packages{$package}\",n(\"\",[a(\"OBJECT\",\"$package\"),a(\"COLOR\",\"$packages{$package}\")],[])),";
}
print "l(\"interface\",n(\"\",[a(\"OBJECT\",\"Interface\"),a(\"_GO\",\"ellipse\")],[])),";
print "l(\"class\",n(\"\",[a(\"OBJECT\",\"Class\")],[])),";
print "l(\"key\",n(\"\",[a(\"OBJECT\",\"Key\"),a(\"_GO\",\"text\")],[";
print "l(\"key->types\",e(\"\",[],r(\"types\"))),";
print "l(\"key->packages\",e(\"\",[],r(\"packages\")))])),";
print "l(\"types\",n(\"\",[a(\"OBJECT\",\"Types\")],[";
print "l(\"types->interface\",e(\"\",[],r(\"interface\"))),";
print "l(\"types->class\",e(\"\",[],r(\"class\")))])),";
print "l(\"packages\",n(\"\",[a(\"OBJECT\",\"Packages\")],[";
foreach $package (keys %packages) {
    print "l(\"packages->".$packages{$package}."\",e(\"\",[],r(\"$packages{$package}\"))),";
}
print "]))";

print "]";