#!/usr/bin/perl -w

# This perl script takes one or multiple source directories as parameter and
# will generate the list of ttcn files contained in these directories and their
# subdirectories. Then it will detect which TTCN-3 tools are installed one the
# system and try to compile the files with each of them.
#
# Three tools are supported so far: Telelogic Tester, MessageMagic and TTworkbench
#
# The console display the result of the compilation of each tool (success or
# not) and filters its output to only display the lines reporting errors or
# warnings. The full output of each tool is saved in a separate file
# (output.[toolname].txt).



# regular expression used to identify which files are TTCN-3 files
$TTCN_FILENAME_PATTERN = "\\.ttcn?\$";


#######################################################################
# An abstract class representing a TTCN-3 tool
package TTCN3Tool;

# constructor
#
#	name	name of the tool
sub new
{
	my ($class, $name) = @_;
	return bless {name => $name}, $class;
}

# report that this tool was detected on this system
#
#	dir	directory in which the tool is installed
#
# Note:		this function should be called from the constructors of the
#		derived classes, it should be called at most once
#
# Note2:	the directory is then stored in the {dir} attribute
sub detected
{
	my ($self, $dir) = @_;
	$self->{dir} = ::get_abs_path ($dir);

	printf "Detected %-24s in %s\n", $self->{name}, $dir;
}

# tell if this tool was detected on the system
sub is_detected
{
	my ($self) = @_;
	return defined $self->{dir};
}

# Check if the file given as parameter is executable, then store 
# this parameter in the {cmd} attribute. This command should be
# the file to be executed to call the compiler.
#
#	cmd	path of the executable
#
sub try_cmd
{
	my ($self, $cmd) = @_;

	# safety check because we store the name of the command here
	$self->is_detected &&
		die "TTCN3Tool::try_cmd must not be called after the tool has been detected";

	$self->{cmd} = ::get_abs_path ($cmd);

	return -X $cmd;
}

# Generate the name of the output file where the output of the compiler will be
# stored. This function currently generates: "output.<name>.txt"
#
# Note:		the name of the compiler is mangled to avoid having strange
#		characters in the result
#
sub output_file_name
{
	$_ = shift->{name};

	s/[^A-Z0-9]/_/ig;

	$_ = "output.$_.txt";

	if (defined $OUTPUT_DIR) {
		$_ = "$OUTPUT_DIR\\$_";
	}
}

# Public interface to execute the compiler
#
# This function execute the command generated by the analyse_cmd() function
# (normally implemented in the derived classes) and store the output into
# the output file given by the function output_file_name().
#
# The output is also duplicated on the console. However, in order to simplify
# the output, it is filtered so that only the lines reporting errors are
# displayed on the console.
#
# The filter is implemented by the match_error() function. Since this filter is 
# compiler-dependent, it is normally reimplemented in the derived classes.
#
#	@files	list of the TTCN-3 input files
#	
#	return	true if the analysis was successful
#
sub analyse
{
	my $self = shift;

#	print "Executing: ", $self->analyse_cmd(@_), "\n";

	unless (open CMD, $self->analyse_cmd(@_)." 2>&1 |") {
		print "Error: cannot execute command: ", $self->analyse_cmd(@_), "\n";
		return undef;
	}
	
	unless (open OUT, '>'.$self->output_file_name) {
		print "Error: cannot open output file: ", $self->output_file_name, "\n";
		return undef;
	}
	
	while (<CMD>) {
		# display only the errors on the console
		$self->match_error ($_)	&& print "\t$_";

		# write everything into the output file
		print OUT $_;
	}
	
	return (close OUT) && (close CMD);
}

# default filter to be used by the analyse() function
#
# By default all the lines are displayed on the console.
#
sub match_error
{
	return 1;
}

########################################################################
# A driver class for controlling the TTCN-3 tool IBM Telelogic Tester
package TTCN3Tool::TelelogicTester;
@ISA = qw(TTCN3Tool);		

# Constructor
#
# This function will detect the latest version of the compiler installed on the
# system in the default path (c:\program files\telelogic)
sub new
{
	$self = TTCN3Tool::new (shift, "Telelogic Tester");
	
	# find the newest telelogic tester version installed on the system
	my $dir = ::find_newest_version_in_dir ("c:\\program files\\telelogic", "^(TAU_)?Tester_"); #ori
	#my $dir = ::find_newest_version_in_dir ("c:\\program files\\telelogic\\TAU_4.2sdsfd"); ## needs to be adjusted """
	
	if ((defined $dir) && ($self->try_cmd ("$dir\\bin\\t3cg.exe"))) { 
		$self->detected($dir);
	}
	return $self;
}

# generate the command line to run the compiler
sub analyse_cmd
{
	my $self = shift;

	return "\"$self->{cmd}\" -D -F -a @_";
}

# match one error line in the compiler output
sub match_error
{
	shift;
	/: (Error|Warning)/;
}


########################################################################
# A driver class for controlling the TTCN-3 tool TestingTech TTworkbench
package TTCN3Tool::TTworkbench;
@ISA = qw(TTCN3Tool);		

# Constructor
#
# This function will detect the compiler installed on the system in the default
# path (c:\program files\TTworkbenchBasic)
sub new
{
	$self = TTCN3Tool::new (shift, "TTworkbench");
	
	foreach my $dir ("c:\\program files\\ttworkbenchbasic118")  #TODO: maybe add other directories to search 
	{
		if ($self->try_cmd ("$dir\\TTthree.bat")) {
			$self->detected ($dir);
			last;
		}
	}
	return $self;
}

# generate the command line to run the compiler
sub analyse_cmd
{
	my $self = shift;

	# TTworkbench needs to know the list of sub-directories where our files
	# are located
	my %subdirs=();
	foreach (@_) {
		if (/^(.*\\)[^\\]+/) {
			$subdirs{$1} = 1;
		} else {
			$subdirs{"."} = 1;
		}
	}
	
	# TTworkbench needs to know one or more root module id so as to know
	# what shall be compiled in these subdirectories
	#
	# Note: the compiler does not support files whose basename does not
	# match the module id that they contain -> so we can afford just 
	# using the basename of our files
	#
	# Note2: we do not know which module is the root one, so we give the
	# full list of modules
	my @modules=();
	foreach (@_) {
		if (/^.*\\([^\\.]+)\.[a-z0-9]+$/i) {
			push @modules, $1;
		} else {
			die "error: cannot extract a module name form the file: $_";
		}
	}

	return "\"$self->{cmd}\" --clean --dry-run --continue --use-bigint --rebuild --strict-standard-compliance enforce --verbosity warning "
			. join (" -P ", "", keys %subdirs)." @modules";
}

# match one error line in the compiler output
sub match_error
{
	shift;
	/^(error|warning|failure):/;
}

########################################################################
# A driver class for controlling the TTCN-3 tool OpenTTCN Tester
#
# warning: this class has not yet been validated
#
package TTCN3Tool::OpenTTCNTester;
@ISA = qw(TTCN3Tool);		

sub new
{
	$self = TTCN3Tool::new (shift, "OpenTTCN Tester");
	
	foreach my $dir ("c:\\program files\\OpenTTCN\\Tester3")  #TODO: maybe add other directories to search 
	{
		if ($self->try_cmd ("$dir\\bin\\importer3.exe")) {
			$self->detected ($dir);
			last;
		}
	}
	return $self;
}

########################################################################
# A driver class for controlling the TTCN-3 tool Elvior MessageMagic
package TTCN3Tool::MessageMagic;
@ISA = qw(TTCN3Tool);		

sub new
{
	$self = TTCN3Tool::new (shift, "Message Magic");
	
	# find the newest telelogic tester version installed on the system
	my $dir = ::find_newest_version_in_dir ("c:\\program files\\elvior", "^MessageMagic5");

	if ((defined $dir) && ($self->try_cmd ("$dir\\mmttcncp.exe"))) {
		$self->detected($dir);
	}
	return $self;
}

# generate the command line to run the compiler
sub analyse_cmd
{
	shift;

	# MessageMagic must be executed from its directory to be able to locate the license

	# transform the file names into absolute file names
	my $cwd = ::cwd();
	my @files = ();
	foreach my $file (@_) {
		push @files, ::get_abs_path ($file);
	}

	return "cd \"$_->{dir}\" && mmttcncp.exe -l \"".(join ';', @files).'"';
}

# match one error line in the compiler output
sub match_error
{
	shift;
	/\* Script.*: Line [0-9]+: /;
}

package main;

# List all the files matching a regular expression in a directory and
# recursively in all its subdirectories
#
#	dir	path of the directory to be scanned
#	pattern	regular expression to be used for selecting the files
#
#	return	an array containing the files that match the pattern
#
sub get_files_in_dir
{
	my ($dir, $pattern) = @_;
	my @result = ();

	(opendir "DIR$dir", "$dir") or die "cannot access directory $dir";
	while ($_ = readdir "DIR$dir")
	{
		next if /^\.\.?$/;
		my $file = "$dir\\$_";

		if ((-f $file) && ($file =~ /$pattern/i)) {
			push @result, $file;
		} elsif (-d $file) {
			my @subdir_result = get_files_in_dir ($file, $pattern);
			push @result, @subdir_result;
		}
	}
	closedir "DIR$dir";

	return @result;
}

# make a comparison of two version numbers
#
# This function compares separately the major an minor version numbers
sub cmp_version
{
	my ($a, $b) = @_;

	my ($a_maj, $a_min, $b_maj, $b_min) = ($a, undef, $b, undef);
	if ($a =~ /^([0-9a-z]+)[_.-]([0-9a-z].*)$/i) {
		($a_maj, $a_min) = ($1, $2);
	}
	if ($b =~ /^([0-9a-z]+)[_.-]([0-9a-z].*)$/i) {
		($b_maj, $b_min) = ($1, $2);
	}
	my $result = undef;
	if (($a_maj =~ /^[0-9]/) && ($b_maj =~ /^[0-9]/)) {
		# numeric comparison
		# FIXME: this comparison ignores letters appended to the
		#	 version: eg. 1.2.3a
		$result = $a_maj <=> $b_maj;
	} else {
		# alphabetical comparison
		$result = $a_maj cmp $b_maj;
	}

	$result && return $result;

	if (defined $a_min) {
		return (defined $b_min) ? cmp_version ($a_min, $b_min) : 1;
	} else {
		return (defined $b_min) ? -1 : 0;
	}
}

# Find the newest versionned subdir in a directory
#
# This function will check the names of the subdirectories located in dir and
# will select the one which has the highest version number in its suffix and that
# matches the pattern
#
#	dir	directory to be scanned
#	pattern	regular expression to detect the elegible subdirectories
#
#	return	the chosen subdirectory in the form "directory\\subdirectory"
sub find_newest_version_in_dir
{
	my ($base_dir, $pattern) = @_;

	(opendir DIR, $base_dir) || return undef;

	my @subdirs = readdir DIR;
	my $max_version = " ";
	my $subdir = undef;
	foreach (@subdirs) {
		if (	(-d "$base_dir\\$_")
		    &&	((!defined $pattern) || /$pattern/i) 
		    &&	/([0-9]+([._][0-9]+)*)$/ 
		    &&	(cmp_version ($max_version, $1) < 0))
		{
			$max_version = $1;
			$subdir = $_;
		}
	}
	closedir DIR;
	
	return (defined $subdir ? "$base_dir\\$subdir" : undef);
}

# Get the absolute path of the current working directory
sub cwd
{
	(open CWD, "cmd.exe /C cd |") or die "Cannot run the interpreter cmd.exe";
	$cwd = <CWD>;
	$cwd =~ /^[A-Z]:/i || die;
	chomp $cwd;
	close CWD;
	return $cwd;
}

# Get the absolute path a file/directory
sub get_abs_path
{
	my $path = shift;

	return (($path =~ /^[A-Z]:/i) ? "" : cwd()."\\" ) . $path;
}


########################################################################
### Beginning of the script                                          ###

# output directory for storing the results
$TTCN3Tool::OUTPUT_DIR = cwd();

# generate the list of TTCN-3 files to be compiled
if (@ARGV == 1) {
	# if there is only one directory given, then we chdir into
	# this directory to have shorter file name
	# (this is purely cosmetical)
	$_ = $ARGV[0];
	chdir $_ or die "Error: cannot chdir into '$_'\n";

	@ttcn_files = get_files_in_dir (".", $TTCN_FILENAME_PATTERN);
} else {
	# otherwise we just use the full directory names
	@ttcn_files = ();
	foreach (@ARGV) {
		-d or die "Error: there is no directory '$_'\n";
		push @ttcn_files, get_files_in_dir ($_, $TTCN_FILENAME_PATTERN);
	}
}

@ttcn_files or die "usage: $0 sourcedir1 [sourcedir2 ...]\n";

print "List of TTCN-3 source files: @ttcn_files\n\n";


# detect the tools installed on the system
my @tools = ();
foreach (
	new TTCN3Tool::TelelogicTester,
#	new TTCN3Tool::OpenTTCNTester,		# FIXME: not supported yet (need a license)
	new TTCN3Tool::MessageMagic,
	new TTCN3Tool::TTworkbench
) {
	$_->is_detected  &&  push @tools, $_;
}

# execute each compiler
foreach (@tools)
{
	print "\nAnalysing the ATS with $_->{name}...\n";
	$_->analyse (@ttcn_files);
}