#! /usr/bin/perl
###########################################################################
#   Copyright (C) 2009 by Hessel Hoogendorp                               #
#   bugs.ccc@gmail.com                                                    #
#                                                                         #
#   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.             #
###########################################################################

# -----------------------------------------------------------------------------
# Modules
# -----------------------------------------------------------------------------
use strict;
use warnings;

use Cwd;
use Cwd 'abs_path';
use File::Copy;
use File::Path;
use File::Basename;


# -----------------------------------------------------------------------------
# Retrieve the environment parameters
# -----------------------------------------------------------------------------
my $CCC_PROJECT_DIR = $ENV{'CCC_PROJECT_DIR'};  # Get the name of root of the source tree.
my $CCC_OUTPUT_DIR  = $ENV{'CCC_OUTPUT_DIR'};   # Get the name of the directory where the call info files should be stored.
my $CCC_LOG_FILE    = $ENV{'CCC_LOG_FILE'};     # Get the name of the log file.
my $CCC_CCIE_ARGS   = $ENV{'CCC_CCIE_ARGS'};    # Get the command line arguments to 'ccie'.


# -----------------------------------------------------------------------------
# Log file handle
# -----------------------------------------------------------------------------
local *LOG_FILE;


# -----------------------------------------------------------------------------
# Main
# -----------------------------------------------------------------------------

ExtractCallInfo();


# -----------------------------------------------------------------------------
# Call information extraction
# -----------------------------------------------------------------------------
my @inputFiles;

sub GetPreprocessedInputFileName
{
	my $inputFile = shift;

	# Get the file name portion of the file path.
	$inputFile = fileparse($inputFile);

	# Replace the extension of a C-source file with ".i".
	$inputFile =~ s/\.c$/\.i/;

	# Replace the extension of a C++-source file with ".ii".
	$inputFile =~ s/\.cc$/\.ii/;
	$inputFile =~ s/\.cp$/\.ii/;
	$inputFile =~ s/\.cxx$/\.ii/;
	$inputFile =~ s/\.cpp$/\.ii/;
	$inputFile =~ s/\.CPP$/\.ii/;
	$inputFile =~ s/\.c++$/\.ii/;
	$inputFile =~ s/\.C$/\.ii/;

	# Prepend the current directory to the input file to create the actual
	# complete path to the preprocessed input file. The compiler will always
	# store the intermediate files in the current directory, regardless of
	# any "-o" specification.
	$inputFile = getcwd() . '/' . $inputFile;

	# Return the renamed input files.
	return $inputFile;
}

sub ParseArguments
{
	my $outputDir = "";

	# The argument processing loop.
	my $length = scalar(@ARGV);
	my $i = 0;
	while($i < $length)
	{
		# Retrieve the current argument and increase the argument index.
		my $arg = $ARGV[$i++];

		# Check for a -o argument.
		if($arg eq '-o')
		{
			if($i >= $length)
			{
				print "AN ERROR OCCURRED WHILE INTERPRETING THE ARGUMENTS:\n";
				print "Option '-o' requires an argument.\n";
				exit(1);
			}

			(my $dummy, $outputDir) = fileparse($ARGV[$i++]);
			if($outputDir !~ m/\/$/)
			{
				$outputDir .= "/";
			}
		}
		# Check for argument that does not start with a "-".
		elsif($arg =~ m/^[^-].*$/)
		{
			if(IsSourceFile($arg))
			{
				# Retrieve the name of the file containing the preprocessed input.
				my $preprocessedInputFileName = GetPreprocessedInputFileName($arg);

				# Consider this to be an input file.
				push(@inputFiles, $preprocessedInputFileName);
			}
		}
	}
	
	return $outputDir;
}

sub ProcessInputFile
{
	# Retrieve the name of the file that should be processed.
	my $outputDir = shift;
	my $inputFile = shift;

	print "\n";
	print "---===[ CALL INFORMATION EXTRACTION ]===---\n";
	
	
	# Copy the 
	if(length($inputFile) > 0)
	{
		# Compose the name the output file containing the call information.
		my $outputFile = $outputDir . fileparse($inputFile) . '.cci';

		# Start composing the extractor command line.
		my $ccieCmd = 'ccie ' . $CCC_CCIE_ARGS . ' -c-output ' . $outputFile . ' ' . $inputFile;

		# Call the extractor.
		if(!Execute($ccieCmd))
		{
			print ":::---::::::---::::::---::::::---::::::---::::::---:::\n";
			print "::: AN ERROR OCCURRED WHILE RUNNING THE EXTRACTOR! :::\n";
			print ":::---::::::---::::::---::::::---::::::---::::::---:::\n";
		}
	}

	print "---===[ END ]===---\n";
	print "\n";
}

sub ProcessInputFiles
{
	my $outputDir = shift;

	# Process each input file.
	foreach my $inputFile (@inputFiles)
	{
		ProcessInputFile($outputDir, $inputFile);
	}
}

sub ExtractCallInfo
{
	# Open the log file.
	open(LOG_FILE, ">>$CCC_LOG_FILE");

	# Parse the arguments.
	my $outputDir = ParseArguments();

	# Process the input files.
	ProcessInputFiles($outputDir);

	# Close the log file.
	close(LOG_FILE);
}


# -----------------------------------------------------------------------------
# Helpers
# -----------------------------------------------------------------------------
sub IsSourceFile
{
	my $inputFile = shift;

	# These extensions, and whether they represent source code, were taken from 'man gcc'.
	return ($inputFile =~ m/\.c$/  ) ||  # ".c"   - C source code
	       ($inputFile =~ m/\.i$/  ) ||  # ".i"   - C source code
	       ($inputFile =~ m/\.ii$/ ) ||  # ".ii"  - C++ source code
	       ($inputFile =~ m/\.cc$/ ) ||  # ".cc"  - C++ source code
	       ($inputFile =~ m/\.cp$/ ) ||  # ".cp"  - C++ source code
	       ($inputFile =~ m/\.cxx$/) ||  # ".cxx" - C++ source code
	       ($inputFile =~ m/\.cpp$/) ||  # ".cpp" - C++ source code
	       ($inputFile =~ m/\.CPP$/) ||  # ".CPP" - C++ source code
	       ($inputFile =~ m/\.c++$/) ||  # ".c++" - C++ source code
	       ($inputFile =~ m/\.C$/  );    # ".C"   - C++ source code
}

sub Execute
{
	my $command = shift;

	# Print what command is being executed.
	print 'Running command: ' . $command . "\n";
	print LOG_FILE 'Running command: ' . $command . "\n";

	# Execute the command and capture its output and its exit code.
	my $output = `$command`;
	my $exitCode = $?;

	# If there is output, print it to standard output.
	if(length($output) > 0)
	{
		print $output;
		print LOG_FILE $output;
	}

	# Return whether the command was successful.
	return $exitCode == 0;
}

