source: trunk/ETSI-Testsuites/ETSI_auto_IOT/validation/ttcn_validation.pl @ 26

#!/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);
}