#!/usr/bin/perl
#gprof2dot: generate a dot file from gprof call graph.

#Usage: just run binary with no params to see usage.

# tirath.ramdas@eng.monash.edu.au, 2006.
# I'm a C guy, and I'm sure it shows... this has got to be some of the
# worst perl ever written, and for that I can only apologise! :-)

#In case of slight differences between gprof flavors, tweaking
# the following may get things to work...

#Finding the start of the call graph is done by looking for these
# tokens on the start of three successive lines, immediately 
# preceeding the callgraph.
@find_start_of_callgraph=("granularity:","index");



#inputs: input and output file names
$number_of_params=$#ARGV;
if($number_of_params<1){
	print "Usage: gprof2dot [input file name] [output file name] {optional: \"calls\"}\n\tSpecifying the \"calls\" param labels arcs with number of calls. \n\tThe default is \"self seconds\".\n";
	exit(-1);
}
$input_file  = @ARGV[0];
$output_file = @ARGV[1];

#select whether to print number of calls or amt of time on graph arcs
$arc_label_selection=0;
if($number_of_params>1){
	if(@ARGV[2] ne "calls"){
		print "Usage: gprof2dot [input file name] [output file name] {optional: \"calls\"}\n\tSpecifying the \"calls\" param labels arcs with number of calls. \n\tThe default is \"self seconds\".\n";
		exit(-1);
	}
	$arc_label_selection=2;
}	



open(INPUT, $input_file) or die("Cannot open file '$input_file' for reading\n");

#find the start of the callgraph...
$i=0;
while($line=<INPUT>){
	#get next line from input
	chomp $line;
	my @fields = split(" ",$line);
#	print ">>",$line,"\n";

	if($fields[0] eq $find_start_of_callgraph[$i]){
#		print "Found ",$fields[0],"\n";
		if($i==1){ 
			#found the last token... found the callgraph!
			last;
		}	
		#look for the next token
		$i++;
#		print "Looking for ",$find_start_of_callgraph[$i],"\n";
	}
}#read input looking for start $f callgraph
#Now we're at the head of the callgraph, but even here formats can
# get a bit hairy... let's explicitly look for the first "[NNN]"...
while($line=<INPUT>){
	#get next line from input
	chomp $line;
	my @fields = split(" ",$line);

	if($fields[0]=~ /\[(\d+)\]/g){
		#found first tree head, record it then start proper callgraph
		# processing
		$head=$fields[-2];
		$drawtree=1;
		last;
	}	
}#read input looking for start $f callgraph


open(OUTPUT,">$output_file") or die("Cannot open file '$output_file' for writing\n");

print OUTPUT "\ndigraph untitled{\n\n\tnode [style=filled];\n\tedge [fontsize=\"9.00\"];\n";
$i=0;
while($line=<INPUT>){
	#get next line from input
	chomp $line;
	my @fields = split(" ",$line);
	print ">>",$line,"\n";

	if($fields[0]=~ /\[(\d+)\]/g){
		#found new tree head, start a new subtree...
		$head=$fields[-2];
		$drawtree=1;
		print "match 1\n";
	}	
	elsif($fields[0]=~ /(\d+)\.(\d+)/){
		if($drawtree==1){
			print "\t",$head,"->",$fields[-2],"[label=\"",$fields[$arc_label_selection],"\"]","\n";
			print OUTPUT "\t",$head,"->",$fields[-2],"[label=\"",$fields[$arc_label_selection],"\"]","\n";
		}
		else{
			print "Ignoring because beyond \"----\"\n";
		}
		print "match 2\n";
	}	
	elsif($fields[0] =~ /(\-)+/g){
		$drawtree=0;
		print "match 3\n";
	}	
	elsif(($fields[0] ne "")
		&&($fields[0] ne "<spontaneous>")){
		print "\n\nleft callgraph.\n";
		#it seems we've left the callgraph...
		last;
	}	
}#process the callgraph



#finish up...
print OUTPUT "\n}\n";
close(OUTPUT);
close(INPUT);