#!/opt/csw/bin/perl -
# Author : Rob G, The Netherlands
#          Based on script by: Valter Mazzola, txian@hotmail.com, Italy
# 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 beginning 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.att.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-files

# 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 graph is large enough
print "   ratio=auto;\n";
print "   rankdir=LR;\n";                           # ) I prefer portait
print "   orientation=portrait;\n";                 # )
print "   node[fontsize=10,fontname=\"Arial\"]\n";  # and another fontname, 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";