#!/usr/bin/perl

use strict ;
use Data::Dumper ;
use CGI ;
use Cwd qw(abs_path) ;
use Getopt::Long ;


sub usage {
	print STDERR "$0 [OPTIONS] GPROF_FILE\n\n" ;
	print STDERR <<USAGE;
Options:
  --rootdir:  Directory where to create the HTML tree. 
              Default is /tmp.
  --maxlines: Maximum number of lines to print fpr flat profile and call graph summary.
              Default is 500.
  --help:     Display this usage message.
USAGE
	exit(1) ;
}


my %opts = () ;
GetOptions(\%opts,
	"help",
	"maxlines=i",
	"rootdir=s",
) or usage() ;
usage() if $opts{help} ;

my $root = $opts{rootdir} || "/tmp" ;
my $max = $opts{maxlines} || 500 ;

my $gprof = $ARGV[0] ;
usage() unless defined($gprof) ;

open(GPROF, "<$gprof") or die ("Can't open '$gprof' for reading: $!") ;

# Create the temporary directory, that will hold the html files.
my $dir = "$root/$gprof.gprof2html" ;
mkdir("$dir") ;

my %FUNCTIONS = () ;
my %FUNCTION_IDS = () ;
my %CYCLES = () ;

my $menu = "<A HREF='$dir/index.html'>[Home]</A> <A HREF='$dir/flat.html'>[Flat Profile]</A> <A HREF='$dir/graph.html'>[Call Graph Summary]</A>" ;


load_index() ;
flat_profile() ;
call_graph() ;
cycles() ;
home() ;


#Index by function name
sub load_index {
	my $in = 0 ;
	while (<GPROF>){
		my $line = $_ ;
		chomp($line) ;

		if (! $in){
			next unless $line =~ /^Index by function name/ ;
			$in = 1 ;
		}
		else {
			my @fields = split(/\s+\[(\d+)\]\s+/, $line) ;
			for (my $i = 1 ; $i < scalar(@fields) ; $i += 2){
				my $id = $fields[$i] ;
				my $func = $fields[$i+1] ;
				$func =~ s/ \(.*?\)$// ; # Remove source file name
				$FUNCTIONS{$func} = $id ;
				$FUNCTION_IDS{$id} = $func ;
			}
		}
	}
	# Rewind the file.
	# print Dumper(\%FUNCTIONS) ;
	seek(GPROF, 0, 0) ;
}


#  %   cumulative   self              self     total
# time   seconds   seconds    calls  ms/call  ms/call  name
# 20.51      0.08     0.08  2203372     0.00     0.00  CF_STRING::Compare(char const*) const
sub flat_profile {
	my $in = 0 ;
	my $nb = 1 ;
	while (<GPROF>){
		my $line = $_ ;
		chomp($line) ;

		if (! $in){
			next unless $line =~ /^ time   seconds   seconds    calls  ms\/call  ms\/call  name/ ;
			$in = 1 ;
			open(FLAT, ">$dir/flat.html") or die("Can't open '$dir/flat.html' for writing: $!") ;
			print FLAT <<HTML;
<HTML>
<HEAD><TITLE>$gprof: Flat profile</HEAD>
<BODY>
<H2>$gprof: Flat Profile<HR></H2>
<PRE>
$menu

<B>  %   cumulative   self              self     total
 time   seconds   seconds    calls  ms/call  ms/call  name</B>
HTML
		}
		else {
			last if $line =~ /^\s*$/ ;
			my $func = substr($line, 54) ;
			my $id = $FUNCTIONS{$func} ;
			
			print FLAT CGI::escapeHTML($line), ($id ? " <A HREF='$dir/$id.html'>[$id]</A>\n" : "") ;
			last if $nb++ == $max ;
		}
	}
	print FLAT <<HTML;
</PRE>
</BODY>
</HTML>
HTML
	close(FLAT) ;
}


#index % time    self  children    called     name
sub call_graph {
	my $in = 0 ;
	my $nb = 0 ;
	my @buf = () ;
	while (<GPROF>){
		my $line = $_ ;
		chomp($line) ;

		if (! $in){
			next unless $line =~ /^index % time    self  children    called     name/ ;
			$in = 1 ;
			open(GRAPH, ">$dir/graph.html") or die("Can't open '$dir/graph.html' for writing: $!") ;
			print GRAPH <<HTML;
<HTML>
<HEAD><TITLE>$gprof: Call Graph Summary</HEAD>
<BODY>
<H2>$gprof: Call Graph Summary<HR></H2>
<PRE>
$menu

<B>index % time    self  children    called     name</B>
HTML
		}
		else {
			last if $line =~ /^\s*$/ ;
			if ($line =~ /^-----------------------------------------------/){
				call_graph_function(\@buf, $nb++) ;
				@buf = () ;
			}
			else {
				push @buf, $line ;
			}
		}
	}
	print GRAPH <<HTML;
</PRE>
</BODY>
</HTML>
HTML
	close(GRAPH) ;
}


sub call_graph_function {
	my $buf = shift ;
	my $nb = shift ;

	# Find the function id.
	my $id = undef ;
	my $func = shift ;
	my $in_cycle = undef ;
	foreach my $line (@{$buf}){
		if ($line =~ /^\[(\d+)(\])? /){
			$id = $1 ;
			$func = substr($line, 45) ;
			if ($func =~ /<cycle (\d+)>/){
				$in_cycle = $1 ;
			} 
			last ;
		}
	}
	die("Can't find function id in call graph buffer:\n" . Dumper($buf)) unless defined($id) ;

	my $pfunc = CGI::escapeHTML($func) ;
	open(FUNC, ">$dir/$id.html") or die("Can't open '$dir/$id.html' for writing: $!") ;
	print FUNC <<HTML;
<HTML>
<HEAD><TITLE>$gprof: $pfunc Call Graph Listing</HEAD>
<BODY>
<H2>$gprof: $pfunc Call Graph Listing<HR></H2>
<PRE>
$menu

<B>index % time    self  children    called     name</B>
HTML

	my $seen_main = 0 ;
	foreach my $line (@{$buf}){
		my $main = 0 ;
		if ($line =~ /^\[(\d+)(\])? /){
			$main = 1 ;
		}

		if (! $main){
			if ($func !~ /^<cycle \d+ as a whole>/){
				if (defined($in_cycle)){
					if ($line =~ /<cycle $in_cycle>/){
						if ($line =~ /.\[(\d+)\]/){
							if (! $seen_main){
								$CYCLES{$in_cycle}->{$1}->{$id} = 1 ;
							}
							else {
								$CYCLES{$in_cycle}->{$id}->{$1} = 1 ;
							}
						}
					}
				}
			}
		}
		else {
			$seen_main = 1 ;
		}

		my $pline = CGI::escapeHTML($line) ;
		$pline =~ s/(.)\[(\d+)\]/$1<A HREF='$dir\/$2.html'>[$2]<\/A>/g ;
		$pline =~ s/&lt;cycle ((\d+)( as a whole)?)&gt;/<A HREF='$dir\/cycle$2.html'>&lt;cycle $1&gt;<\/A>/g ;
		if ($main){
			print FUNC "<A NAME='f'></A>" ;
			print GRAPH "$pline\n" unless $nb >= $max ;
		}

		print FUNC "$pline\n" ;
	}

	print FUNC <<HTML;
</PRE>
</BODY>
</HTML>
HTML
	close(FUNC) ;
}


sub cycles {
	foreach my $cycle (keys %CYCLES){
		open(CYCLE, ">$dir/cycle$cycle.dot") or die("Can't open '$dir/cycle$cycle.dot' for writing: $!") ;
		print CYCLE "digraph cycle$cycle {\n" ;
		foreach my $caller (keys %{$CYCLES{$cycle}}){
			my $label = $FUNCTION_IDS{$caller} ;
			print CYCLE "  $caller [href=\"$caller.html\",tooltip=\"$label\",fontsize=8] ;\n" ;
			foreach my $callee (keys %{$CYCLES{$cycle}->{$caller}}){
				print CYCLE "  $caller -> $callee\n" ;
			}
		}
		print CYCLE "}\n" ;
		close(CYCLE) ;

		system("/usr/bin/dot -Tpng $dir/cycle$cycle.dot > $dir/cycle$cycle.png") ;
		open(MAP, ">$dir/cycle$cycle.html") or die("Can't open '$dir/cycle$cycle.html' for writing: $!") ;
		my $cycle_id = $FUNCTIONS{"<cycle $cycle>"};
		print MAP <<HTML;
<HTML>
<HEAD><TITLE>$gprof: Cycle $cycle Call Graph Image</HEAD>
<BODY>
<H2>$gprof: Cycle $cycle Call Graph Image<HR></H2>
<BODY>
<PRE>
$menu <A HREF='$cycle_id.html'>[Cycle $cycle Call Graph Listing]</A>
<IMG SRC='$dir/cycle$cycle.png' USEMAP='#cycle$cycle'>
HTML
		system("/usr/bin/dot -Tcmapx $dir/cycle$cycle.dot >> $dir/cycle$cycle.html") ;
		seek(MAP, 0, 2) ;
		print MAP <<HTML;
</PRE>
</BODY>
</HTML>
HTML
		close(MAP) ;
	}
}


sub home {
	open(IDX, ">$dir/index.html") or die("Can't open '$dir/index.html' for writing: $!") ;
	print IDX <<HTML;
<HTML>
<HEAD><TITLE>$gprof: Home</HEAD>
<BODY>
<H2>$gprof: Home<HR></H2>
<PRE>
$menu
</PRE>
</BODY>
</HTML>
HTML
	close(IDX) ;

	print "file://" . abs_path($dir) . "/index.html\n" ;
}
