#!/usr/bin/perl
# ********************************************************************
#
#  This program is free software; you can redistribute it and/or modify it 
#  under the terms of the GNU General Public License as published by the Free 
#  Software Foundation; either version 2 of the License, or (at your option) 
#  any later version.
#  
#  This program is distributed in the hope that it will be useful, but WITHOUT 
#  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
#  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for 
#  more details.
#  
#  You should have received a copy of the GNU General Public License along with
#  this program; if not, write to the Free Software Foundation, Inc., 59 
#  Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#  
#  The full GNU General Public License is included in this distribution in the
#  file called LICENSE.
#  
#  Contact Information:
#                       Lexi Pimenidis, <lexi@i4.informatik.rwth-aachen.de>
#                       RWTH Aachen, Informatik IV, Ahornstr. 55 - 52056 Aachen - Germany
#*******************************************************************************
# 
# CREATED AND DESIGNED BY 
#    Lexi Pimenidis, lexi@i4.informatik.rwth-aachen.de
#
#



# FAST DOCU
#
# 1. install graphviz
# 2. run ./tree.pl with some .c files as parameter
# 
use strict;

my $outfile = "callgraph.ps";
my $outfile2 = "file2file.ps";

my $tempfile = "callgraph.dot";
my $tempfile2 = "file2file.dot";

# check if executables are there
my %execs = ('ctags' => 1 ,'dot' => 1); # set value to 1 if mandantory, 0 for optional
my %use_exec;
foreach my $tool (keys %execs) {
	$use_exec{$tool} = `which $tool`;
	$use_exec{$tool} =~ s/\n//gs;
	print "use '$use_exec{$tool}'\n";
	unless(-x $use_exec{$tool}) {
		warn("could not find executable $tool"); 
		exit 1 if ($execs{$tool});
	}
}
#die("you'll probably need either dot or neato") unless($use_exec{'dot'} || $use_exec{'neato'});

# IN: string
# OUT: string without C-style comments and empty brackets
sub rip_comments {
	my ($src) = @_;
	# rip comments
	$src =~ s/\/\/.*?$//gsm;
	$src =~ s/#.*?$//gsm;
	$src =~ s/\/\*.*?\*\///gs;
	# remove empty lines
	$src =~ s/^\s*$//gsm;
	# remove all content from brackets ()
	#while($src =~ s/\([^()]+?\)/()/gs) {};
	return $src;
}

my %keyword;  # hash of arrays containing the files
my %files;    # hash of arrays containing the keywords
my %sources;  # hash of line-array of plain sources
my %calls;    # hash of array of called functions
my %called;   # hash of integers, counting the number of callers
my %starts;   # hash of hash with the function at a line starting
my %location; # hash of hash with the starting line of a function

# search for all keywords
foreach(@ARGV) {
	foreach my $file (glob($_)) {
		print "search $file ...";
		$files{$file} = [];
		#******** get source
		open(SRC,"< $file") || die($!);
		@{$sources{$file}} = <SRC>;
		close(SRC);
		#******** parse functions out of c-source
		$starts{$file} = {};
		$location{$file} = {};
		open(LOC,$use_exec{'ctags'}." -x $file |") || die($!);
		while(<LOC>) {
			if(/^(\S+)\s.*?(\d+)/sm){
				$location{$file}{$1}=$2; 
				$starts{$file}{$2} = $1;
				push @{$files{$file}},$1;
				#print "$1 $2\n";
			} else {
				warn("$_ does not suit to my regular expression");
			}
		}
		close(LOC);
		# store for each file the keywords
		# store for each keyword, in which file it can be found
		foreach my $w (@{$files{$file}}) {
			#print " $w";
			unless(defined($keyword{$w})) {
				$keyword{$w} = {$file => 1};
				$calls{$w} = [];
			} else {
				$keyword{$w}{$file} = 1;
			};
		};
		print "\n";
	}
}


#do call-graph
foreach my $file (keys %files) {
	foreach my $word (@{$files{$file}}) {
		# find code for this function in source
		my $code;
		for(my $i=$location{$file}{$word};!defined($starts{$file}{$i+1}) || ($starts{$file}{$i+1}eq$word);++$i) {
			last unless(${$sources{$file}}[$i]);
			$code .= ${$sources{$file}}[$i];
		}
		#print "---------------$file $word ".$location{$file}{$word}."\n";
		#print $code;
		$code = rip_comments($code);
		# iterate through all words in this code and check if they are known as symbols
		while($code =~ /([a-z_0-9]+)/gsi) {
			my $blubb = $1;
			if (defined($keyword{$blubb})) {
				#print "$word calls $blubb\n";
				push @{$calls{$word}}, $blubb;
				++$called{$blubb};
			}
		}
	}
}

# print call-graph function-wise
unless($use_exec{'dot'}) {
	warn("not painting $outfile because 'dot' not there\n");
} else {
	open(DOT,"> $tempfile") || die($!);
	print DOT "digraph blubb {\n";
	print DOT "  size=\"10,7\";\n";
	print DOT "  rankdir=LR;\n";
	print DOT "  overlap=scale;\n";
	print DOT "  node [style=\"rounded,filled\",shape=box, color=blue, fontcolor=black,fillcolor=yellow,fontname=Helvetica];\n";
	print DOT "\n";
	# create subgraphs for files and order the keywords into them
	my $cnt=0;
	foreach my $file(keys %files) {
		++$cnt;
		my $sgname = $file.$cnt;
		$sgname =~ s/[^a-z0-9_]//gs;
		print DOT "  subgraph cluster_$sgname { \n";
		print DOT "    label=\"$file\";\n";
		print DOT "    style=\"filled\";\n";
		print DOT "    color=\"lightgrey\";\n";
		print DOT "    \"$file\" [shape=ellipse,fillcolor=green];\n";
		foreach my $word (@{$files{$file}}) {
			if (@{$calls{$word}} || $called{$word}) {
				print DOT "    \"$word\";\n";
			}
		}
		print DOT "  }\n";
		print DOT "\n";
	}
	# create relation callers and callees
	foreach my $caller (keys %calls) {
		my %seen;
		undef %seen;
		foreach my $callee (@{$calls{$caller}}) {
			print DOT "  \"$caller\" -> \"$callee\";\n" unless($seen{$callee}++);
		}
		print DOT "\n";
	}
	print DOT "}\n";
	close(DOT);

	print "painting $outfile\n";
	system($use_exec{'dot'}." -Tps $tempfile -o $outfile");
	unlink($tempfile);
}

# print call-graph file2file
unless($use_exec{'dot'}) {
	warn("not painting $outfile2 because 'dot' not there\n");
} else {
	print "painting $outfile2\n";
	open(DOT,"> $tempfile2") || die($!);
	print DOT "digraph blubb {\n";
	print DOT "  size=\"7,10\";\n";
	print DOT "  rankdir=LR;\n";
	print DOT "  overlap=scale;\n";
	print DOT "  node [style=\"rounded,filled\",shape=box, color=blue, fontcolor=black,fillcolor=yellow,fontname=Helvetica];\n";
	print DOT "\n";
	foreach my $file(keys %files) {
		my %seen;
		undef %seen;
		print DOT "    \"$file\" [shape=ellipse,fillcolor=green];\n";
		foreach my $file2(keys %files) {
			unless ($file eq $file2) {
				# check if $file calls $file2
				my $calls = 0;
				LOOP: {
					foreach my $word (@{$files{$file}}) {
						foreach my $calling (@{$calls{$word}}) {
							foreach my $otherfile (keys %{$keyword{$calling}}) {
								if ($otherfile eq $file2) { $calls=1; last LOOP; };
							}
						}
					}
				}
				# print?
				if ($calls && (!($seen{$file2}++))) {
					print DOT "  \"$file\" -> \"$file2\";\n";
				}
			}
		}
	}
	print DOT "}\n";
	close(DOT);

	system($use_exec{'dot'}." -Tps $tempfile2 -o $outfile2");
	unlink($tempfile2);
}