Category: | Programming Tools |
Author/Contact Info | by bikeNomad, Ned Konz <ned@bike-nomad.com>. POD and multi-line @ISA handling by ZZamboni. Fixes by Hofmator |
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()) } |
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Graph your Perl inheritance structure
by ZZamboni (Curate) on Jun 11, 2001 at 02:02 UTC | |
Re: Graph your Perl inheritance structure
by Beatnik (Parson) on Jun 11, 2001 at 01:47 UTC | |
Re: Graph your Perl inheritance structure
by Hofmator (Curate) on Jun 14, 2001 at 13:58 UTC | |
Re: Graph your Perl inheritance structure
by Anonymous Monk on Jun 02, 2011 at 18:58 UTC |
Back to
Code Catacombs