Description: |
Graphs the inheritance (@ISA) structure of given files or directories using GraphViz. Can produce ps,hpgl,pcl,mif,pic,gd,gd2,gif,jpeg, png,wbmp,vrml,vtx,mp,fig,svg or dot/neato outputs. Also can produce client- or server-side image maps. |
#!/usr/bin/perl -w
# Graphs the ISA structure of given files or directories using GraphVi
+z
# Can produce ps,hpgl,pcl,mif,pic,gd,gd2,gif,jpeg, png,wbmp,vrml,vtx,m
+p,fig,svg
# or dot/neato outputs.
# Also can produce client- or server-side image maps.
#
# Ned Konz <ned@bike-nomad.com>
# $Revision: 1.5 $
use strict;
use IO::File;
use File::Find;
use Getopt::Std;
use GraphViz;
sub usage
{
print <<EOF;
$0 -- Graphs the inheritance structure of Perl files
By Ned Konz, <ned\@bike-nomad.com>
usage: $0 [-r] [-R] [-f outfile] [-l listfile] [-h] [-v] [-u URLtempl]
+ [file|dir [...]] [>mapfile]
-r recurse into dirs
-R layout left to right (default: up-down)
-f outfile specify output file (default=graphisa.png)
-l listfile get filenames/options from listfile
-h get this help message
-v list filenames to STDERR
-u URLtempl set image map URL to URLtempl (\\N replaced by pkg, \\F r
+eplaced by file)
image map will be written to STDOUT
-s make server side image map rather than client side
-i fmt set image format to fmt (default=png)
also available: canon,text,ps,hpgl,pcl,mif,pic,gd,gd2,gif
+,jpeg,
png,wbmp,vrml,vtx,mp,fig,svg,plain
If directory names are given, all the *.p[lm] files in the directory w
+ill
be processed. The default is to do all the Perl files in the current d
+irectory.
EOF
exit shift;
}
# process cmdline options
my $opts = 'Rrf:l:hvu:si:';
my %opts;
getopts($opts, \%opts) || usage(1);
usage(0) if defined($opts{h});
while (defined($opts{l}))
{
my $lFile = IO::File->new($opts{l}) or die "can't open -l file $op
+ts{l} : $!\n";
my @largs = <$lFile>;
chomp(@largs);
splice(@ARGV, 0, 0, @largs);
delete($opts{l});
getopts($opts, \%opts) || usage(1);
$lFile->close();
}
$opts{i} = 'png' if !exists($opts{i});
my $outfile = defined($opts{f}) ? $opts{f} : "graphisa.$opts{i}";
# now filenames are in @ARGV
push(@ARGV, '.') if !@ARGV;
my @files;
my $top;
my $nDirs;
sub findPerlFiles
{
-f _ && /^.*\.p[lm]\z/si && push(@files, $File::Find::name);
$File::Find::prune = !defined($opts{r}) && $nDirs > 1;
-d _ && $nDirs++;
}
# process directories
foreach $top (@ARGV)
{
$nDirs = 0;
File::Find::find({wanted => \&findPerlFiles}, $top);
}
my $g = GraphViz->new(rankdir => $opts{R} || 0);
foreach my $file (@files)
{
$file =~ s#^./##;
STDERR->print("processing $file\n") if $opts{v};
my $f = IO::File->new($file) or warn "can't open $file: $!\n", nex
+t;
my ($package, @isa);
my $pod = 0;
while (<$f>)
{
if (/^=cut/)
{
$pod=0;
next;
}
if (/^=[a-zA-Z]+/)
{
$pod=1;
next;
}
next if $pod;
if (/^\s*package\s+([[:word:]:]+)\s*;/)
{
$package = $1;
next;
}
if (/(?<!\\)@(?:([[:word:]:]+)::)?ISA\s*=\s*(.*)/)
{
$package = $1 if defined($1);
my $tmp = $2;
while (!/;/) # accumulate ISA value for multiple lines
{
$_ = <$f>;
$tmp .= $_;
}
@isa = eval $tmp;
if ($@) { warn "Unparseable \@ISA line: $tmp"; next }
STDERR->print("package=$package, \@ISA=", join(',', @isa),
+ "\n") if $opts{v};
(my $url = $opts{u} || '\\F') =~ s/\\F/$file/g;
$g->add_node($package, shape => 'box', URL => $url);
foreach (@isa)
{
$g->add_node($_, shape => 'box', URL => $url);
$g->add_edge($package, $_);
};
}
}
$f->close();
}
my $output = IO::File->new($outfile, 'w') or die "can't open $outfile:
+ $!\n";
$output->print(eval "\$g->as_$opts{i}()");
$output->close();
if (exists($opts{u}))
{
STDOUT->print(exists($opts{s}) ? $g->as_imap : $g->as_ismap())
}
|