Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Generate a Graph-ical call tree for your *.pm perl modules

by trony (Novice)
on May 25, 2000 at 04:10 UTC ( [id://14690]=perlcraft: print w/replies, xml ) Need Help??

   1: #!/usr/bin/perl
   2: # Author : Valter Mazzola, txian@hotmail.com, Italy
   3: # Date 25/May/2000, Local time 01:00 AM.
   4: 
   5: # Purpose:
   6: # ---> Generate a Graph-ical call tree for your *.pm perl module files.
   7: # gra.pl assume that:
   8: # 1- you have defined sub(s) with  'sub myfunc {' with 'sub' at the beginning of line.
   9: # 2- you call your sub with the '&', i.e.  &my_sub ();
  10: 
  11: # The code isn't clean nor perfect ! I've made it in 30 min (including testing) !
  12: 
  13: # usage: 
  14: # 1) generate the .dot text graph file definition  
  15: #    perl gra.pl *.pm > myfile.dot
  16: # 2) generate the graph using 'dot' executable ( http://www.research.att.com/sw/tools/graphviz/ )
  17: #    dot -Tps myfile.dot -o myfile.ps
  18: # 3) display the graph
  19: #    ghostview myfile.ps (choose BBox format)  
  20: 
  21: while (<>){ 
  22:     if (/^sub\s+(.*?)\s*\{/){
  23:         $cur_sub=$1;	
  24:     }
  25:     if (/\&([\d\w_]+)\s*\(/){
  26:         $c_sub = $1;
  27:         $n = 0;
  28:         foreach $k (@{$called_subs{$cur_sub}}) {
  29:             if ($c_sub eq $k){
  30: 		$n = 1;
  31: 		last;
  32: 	    }
  33: 	} 
  34:         if ($n == 0) {
  35: 	   push @{$called_subs{$cur_sub}}, $c_sub;
  36:         }
  37:     }
  38: }
  39: 
  40: print "digraph G {\n";
  41: print "   ratio=auto;\n";
  42: 
  43: foreach $k (keys(%called_subs)){
  44:     $ref_arr = $called_subs{$k};
  45:     if (ref($ref_arr)) {
  46: 	foreach $y (@{$ref_arr}){
  47: 	    print "   $k -> $y;\n";
  48: 	}
  49:     }
  50: }
  51: 
  52: print "}\n";

Replies are listed 'Best First'.
RE: Generate a Graph-ical call tree for your *.pm perl modules
by merlyn (Sage) on May 25, 2000 at 09:29 UTC
RE: Generate a Graph-ical call tree for your *.pm perl modules
by johannz (Hermit) on May 25, 2000 at 20:36 UTC
    If all you are concerned about is what modules are being used, and you're not concerned about what particular methods are being used, you can use Devel::Modlist available from CPAN.
    You run the script with the -d:Modlist option and when the script ends, it displays what modules packages were loaded and their version numbers, if set. The downside is you do have to run the script; the upside is this will handle dynamic including of packages.
RE: Generate a Graph-ical call tree for your *.pm perl modules
by ZZamboni (Curate) on May 25, 2000 at 04:33 UTC
    This is very cool, particularly for such a short program. I like dot a lot. It is a very powerful graphing engine.

    The problem of this script is, of course, that not everyone uses the & convention for calling subroutines. One thing that comes to mind is flag "x" (1024) for the -D option to perl, which does a syntax tree dump. I have never seen its output, and I don't have perl compiled with -DDEBUGGING, but I wonder it that could be used to generate a more complete call tree.

    The other option would be to run the script with "perl -d:DProf" (using the Devel::DProf module) and then use the call graph generated by dprofpp to generate the dot output. In this case, however, only the subroutines that got called during the execution are graphed.

    Very interesting problem, in any case.

    --ZZamboni

Re: Generate a Graph-ical call tree for your *.pm perl modules
by Anonymous Monk on May 07, 2003 at 00:17 UTC
    If you use B::Deparse, you get the complete parse structure, all the "use" .....

    BUT ...

    the ampersands are there.

    More the the point, the module definitions are expanded:

       &MyLib:Storage::CVS($filename,$user,$version,$comment);

Re: Generate a Graph-ical call tree for your *.pm perl modules
by RobG (Initiate) on May 24, 2012 at 07:11 UTC

    I made some improvements on the program, so it will handle the command line arguments and it will show the parent filename at each node. And there is no need to generate a PS image.

    #!/opt/csw/bin/perl - # Author : Rob G, The Netherlands # Based on script by: Valter Mazzola, txian@hotmail.com, Ital +y # Date : 24/May/2012 # Purpose: # ---> Generate a Graph-ical call tree for your *.pm perl module files +. # gra.pl assumes that: # 1- you have defined sub(s) with 'sub myfunc {' with 'sub' at the be +ginning of line. # 2- you call your sub with the '&' and brackets, i.e. &my_sub (); # usage: # 1) generate the .dot text graph file definition # perl gra.pl *.pm > myfile.dot # 2) generate the graph using 'dot' executable ( http://www.research.a +tt.com/sw/tools/graphviz/ ) # dot -Tjpg myfile.dot -o myfile.jpg # 3) display the graph # JPG viewer use File::DosGlob; my $fc = 1; # a file counter to distingguish between multiple main-fil +es # first expand the command line arguments @ARGV = map { my @g = File::DosGlob::glob($_) if /[*?]/; @g ? @g : $_; } @ARGV; # then loop through all files and exclude myself from the loop for my $file (@ARGV) { if ($file ne $0) { open(my $fh, $file) or die "Can't open $file: $!\n"; $cur_sub = "main".$fc; # used to show the parent of main subs $fc++; while (<$fh>) { if (/^sub\s+(.*?)\s*\{/) { $cur_sub = $1; $modules{$cur_sub} = $file; } if (/\&([\d\w_]+)\s*\(/){ $c_sub = $1; $n = 0; foreach $k (@{$called_subs{$cur_sub}}) { if ($c_sub eq $k) { $n = 1; last; } } if ($n == 0) { push @{$called_subs{$cur_sub}}, $c_sub; $modules{$cur_sub} = $file; } } } close $fh; } } print "digraph G {\n"; print " page=\"44,68\";\n"; # make sure the gr +aph is large enough print " ratio=auto;\n"; print " rankdir=LR;\n"; # ) I prefer porta +it print " orientation=portrait;\n"; # ) print " node[fontsize=10,fontname=\"Arial\"]\n"; # and another font +name, fontsize # first we define the label and shape of each node # the label is contructed from the name of the sub and the name of the + parent file # the shape for the main entries is different from the other nodes # # a side-effect: it will show all sub's that are not used too while (($key, $value) = each (%modules)) { if (substr($key, 0, 4) eq "main") { print " $key [shape=ellipse,label=\"main\\n($value)\"];\n"; } else { print " $key [shape=box,label=\"$key\\n($value)\"];\n"; } } # then we define the paths between the nodes foreach $k (keys(%called_subs)) { $ref_arr = $called_subs{$k}; if (ref($ref_arr)) { foreach $y (@{$ref_arr}){ print " $k -> $y;\n"; } } } print "}\n";

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlcraft [id://14690]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2024-03-19 11:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found