Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl -w # =head1 NAME sub_graph.pl - perl subroutine call graph generator =head1 SYNOPSIS sub_graph.pl <options> my_perl_files sub_graph.pl -help =head1 VERSION 0.2 July, 2000 by Alan Ferrency (alan@ferrency.com) =head1 DESCRIPTION sub_graph.pl Analyzes a list of (perl) files specified on the command line using B::Xref, and outputs a .dot format calling graph, with nodes corresponding to perl subs, and edges corresponding to subroutine calls from one subroutine to another. The .dot file format is used by AT&T's free GraphViz software to draw the specified graph. dot, part of GraphViz, can be used to create .ps or .gif format representations of the calling graph. =cut use strict; # Make some options. Too bad this is as long as the rest of the code. use Getopt::Simple qw($switch); my $options = { 'help|h|?' => { 'type' => '', 'env' => '', 'default' => '', 'order' => 1, 'verbose' => 'This message' }, 'output_file' => { 'type' => '=s', 'default' => '-', 'verbose' => 'Output filename', 'order' => 2, 'env' => '' }, 'header_file' => { 'type' => ':s', 'env' => '', 'default' => 'graph.head', 'order' => 2, 'verbose' => 'File to prepend to .dot output' }, 'skips_file' => { 'type' => ':s', 'env' => '', 'default' => 'graph.skips', 'order' => 2, 'verbose' => "File with a list of files we shouldn't parse" }, 'skip_nonperl_files' => { 'type' => '!', 'env' => '', 'default' => 1, 'order' => 6, 'verbose' => "Skip files whose first line doesn't m|^\#\!.*/pe +rl|" }, 'graph_name' => { 'type' => '=s', 'env' => '', 'default' => 'mygraph', 'order' => 3, 'verbose' => 'name of dot graph' }, 'special_nodes_fn' => { 'type' => '=s', 'env' => '', 'default' => 'graph.special', 'order' => 4, 'verbose' => 'file containing a list of "special" nodes (subro +utines).' }, 'special_node_attr' => { 'type' => '=s', 'env' => '', 'default' => '[color=grey,style=filled]', 'order' => 5, 'verbose' => 'dot attributes to use on every "special" node' }, 'perl' => { 'type' => '=s', 'env' => 'PERL', 'default' => '/usr/bin/perl', 'order' => 3, 'verbose' => 'where does perl live? (used as $PERL -B::Xref < +fname>)' }, 'verbose' => { 'type' => '+', 'env' => '', 'default' => 0, 'order' => 3, 'verbose' => 'Talk a lot, but say very little.' }, 'special_edges_only' => { 'type' => '!', 'env' => '', 'default' => 0, 'order' => 7, 'verbose' => "Display only edges to and from nodes in the spec +ial node list.\n\tThis takes priority over from_special_no ds_only and to_special_nodes_only." }, 'from_special_nodes_only' => { 'type' => '!', 'env' => '', 'default' => 0, 'order' => 8, 'verbose' => 'Display only edges from a node in the special no +de list' }, 'to_special_nodes_only' => { 'type' => '!', 'env' => '', 'default' => 0, 'order' => 9, 'verbose' => 'Display only edges to a node in the special node + list' }, 'no_internal_edges' => { 'type' => '!', 'env' => '', 'default' => 0, 'order' => 10, 'verbose' => 'Use this to suppress drawing of edges between tw +o special nodes\n\t(edges internal to the special node sub graph)' }, 'special_subgraph' => { 'type' => '!', 'env' => '', 'default' => 0, 'order' => 7, 'verbose' => "Build special nodes into a subgraph, with option +al attributes as specified" }, 'subgraph_attributes' => { 'type' => '=s', 'env' => '', 'default' => 0, 'order' => 7, 'verbose' => "Attribute codes for special subgraph" } }; my $o = new Getopt::Simple; exit (-1) if (! $o->getOptions($options, "Usage: $0 [options]")); # Everything else is a list of perl files to parse. my @files = @ARGV; # If we are told, skip all nonperl files if ($switch->{'skip_nonperl_files'}) { @files = grep { # implicitly and silently skip files we can't open. open F, "$_" and <F> =~ m|^\#\!.*/perl|; } @files; } # Implicitly skip tilde and hash files @files = grep {!/~$|^#.*#$/} @files; # read in a list of files to skip, and skip them. if (-f $switch->{'skips_file'}) { my %skip; open F, "$switch->{'skips_file'}" or die "Can't open $switch->{'sk +ips_file'} for reading"; while (<F>) { chomp; foreach (split /\s+/) { $skip{$_}++; } } @files = grep { !$skip{$_} } @files; } print "I will analyze the following files:\n". join ("\n", @files) if +$switch->{'verbose'}; # Read in "special" nodes list my %want; if (-f $switch->{'special_nodes_fn'}) { open F, "$switch->{'special_nodes_fn'}" or die "Can't open $switch +->{'special_nodes_fn'} for reading"; while (<F>) { chomp; foreach (split /\s+/) { $want{$_}++; } } } # Next, analyze Xref output for each file specified. my $cur_sub; # name of the sub we're currently "in" # HoH, where exists($edges{A}->{B}) means we have an edge from A to B my %edges; # Build a HoH with edge counts. for my $f (@files) { # Xref will print "syntax OK" or errors to STDERR; we don't mind. open X, "$switch->{'perl'} -MO=Xref $f|"; while (<X>) { chomp; print "--Xref: $_\n" if $switch->{'verbose'} > 2; if (/Subroutine \(?([^()]*)/) { $cur_sub = $1; $cur_sub = "${f}_MAIN" if $cur_sub eq "main"; $cur_sub =~ tr/.:/__/; # dot doesn't like punctuation. } elsif (/^\s*\&(\w\S+)\s*/) { next if $cur_sub eq "definitions"; # seemed like a good id +ea at the time my $s = $1; $s =~ s/:/_/g; $edges{$cur_sub}->{$s}++; } } } # Output a .dot file open DOT, ">$switch->{'output_file'}" or die "Can't open $switch->{'output_file'} for writing"; # First, start the graph print DOT "digraph $switch->{'graph_name'} {\n"; # If we have a header file, stick it in if (-f $switch->{'header_file'}) { open HEAD, "$switch->{'header_file'}" or die "Can't open $switch->{'header_file'} for read"; while (<HEAD>) { print DOT; } close HEAD; } # Next, give Wanted Nodes special treatment. As a side effect, these # nodes will always show up on the graph even if no edges touch them. map { print DOT "$_$switch->{'special_node_attr'};\n" } keys %want; # Build a special subgraph if we request it if ($switch->{'special_subgraph'}) { print DOT "{$switch->{'subgraph_attributes'};"; map { print DOT " $_" } keys %want; print DOT "}\n"; } # set up some temporary variables for brevity and speed # we want all the edges unless specified otherwise my $want_all = !$switch->{'special_edges_only'} && !$switch->{'from_special_nodes_only'} && !$switch->{'to_special_nodes_only'}; my $want_from = $switch->{'special_edges_only'} || $switch->{'from_special_nodes_only'}; my $want_to = $switch->{'special_edges_only'} || $switch->{'to_special_nodes_only'}; my $want_int = !$switch->{'no_internal_edges'}; if ($switch->{'verbose'}) { print "I am" . (!$want_all && " not") ." printing all edges\n"; print "I am" . (!$want_to && " not") ." printing edges to special +nodes.\n"; print "I am" . (!$want_from && " not") ." printing edges from spec +ial nodes.\n"; print "I am" . (!$want_int && " not") ." printing edges between sp +ecial nodes.\n"; } for my $n1 (sort keys %edges) { foreach my $n2 (sort keys %{$edges{$n1}}) { print DOT " $n1 -> $n2;\n" if $want_all || ($want{$n1} && $want_from && ($want_int || !$want{$n2} +)) || ($want{$n2} && $want_to && ($want_int || !$wan +t{$n1})); # Announce large edge counts if we're talking too much if ((my $n = $edges{$n1}->{$n2}) > 1) { print "There are $n edges between $n1 and $n2\n" if $switc +h->{'verbose'} > 1; } } } print DOT "}"; close DOT; __END__

In reply to sub_graph.pl: perl call graph generator by ferrency

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others goofing around in the Monastery: (7)
As of 2024-03-19 09:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found