#!/bin/sh
#!/usr/bin/perl -w
#
# Usage: prlgcc -product qac|qacpp|qac++
#               -version <product version number>
#               -headers <destination substitute header directory>
#               -personalities <destination personality file directory>
#               -[compiler <compiler exe name>]
#               -[pcpaths] (implied if OS is cygwin)
#
# Devious magic to start Perl
eval 'exec perl -S -x "$0" ${1+"$@"}'
    if 0;

#######################################################################
# Change history
# 12/03/2003 -c added to command line to suppress .o file
#            Separation of header files into g++-headers and 
#              gcc-headers
#            Remove checks for omitted include directories
#            switch to shortened versions of QA C[++] directives.
#
# 06/05/2003 New command line option to translate Unix paths to PC paths
#            Useful for analysing Unix source with PC GUI.
#
# 06/05/2003 New function to extract more comprehensive implicit defs
#            from compiler using gcc|g++ -E -dM <source>
# 
# 19/05/2003 makeHeaders only copies files / creates directories.
#            New function getSubSearchPaths builds a list of search
#            paths for substitute headers.
#
# 08/09/2003 New directory structure to allow different configurations
#            between product versions.
#
# 5 Apr 2004 Incorporate suggested improvements from Dedicated Systems
#            inc.
#            Support for cygwin mount points
#            Simplify capture of compiler details
#            Simplify generation of cannonical paths
#            Simplify path separator translation
#
# 1 Jan 2010 Added compiler flag back into script to accept command line comiler option
#            (Added support for later versions of gcc/g++ 4.0->4.4)
#            Added loop for multiple force include files exiting in the prlforcecinclude folder
#######################################################################
use strict;
use FileHandle;
use Cwd;
use Cwd 'chdir';    # Keep $PWD up to date.
use File::Basename; # OS independent way to extract basename from path.
use File::Copy;     # OS independent file copy.
use File::Path;     # For makepath.
use Getopt::Long;   # To parse command line parameters

#####################################################################
# local scope variables visible to subroutines.
#####################################################################
our $prlgcc_version = "4.1";


#####################################################################
# private scope variables not visible to subroutines.
#####################################################################

my $compiler_exe;        # compiler exeutable - could be x compiler
my $compiler;            # C or C++ compiler
my $toolVersion;         # Config number matches QA C or QA C++ version
my $gccVersion;          # Compiler version. Treated as a string just
                         # in case there n.nna version.
my $subheadDir;          # Directory for substitute header files.
my $personDir;           # Directory for personality files.
my $usePCPaths;          # Translate Unix paths to PC format ?
my $cygwin;              # Cygwin environment ?  Implies usePCPaths.
my @omittedIncludePaths; # Default system include paths ommitted 
                         # from search list
my @sysIncludePaths;     # System include paths configured for compiler
my @substituteHeaders;   # Paths for substitute headers.
my @sysDefines;          # System macros defined by -D...
my $ph;                  # Filehandle for gcc process.
my $configVersion;       # configuration version actually used.
my $currentDir;          # storage for current working directory.
my $manual;				 # decide on compiler versions automatically
						 # instead of asking user
my $display;             # display full generated personality file name at end

($compiler_exe, $compiler,$toolVersion,$subheadDir,$personDir,$usePCPaths,$cygwin, $manual, $display) 
    = initialise(); # Check command line

# Ensure our test file does not already exist.
# Should not if executed in packedaged directory and script did
# not exit abnormally.

if (-e "test.c") {
    die("The file \"test.c\" already exists.  This chould be " .
        "through an earlier abnormal termination of this script. ".
        "Please ensure this is not source code and remove from this ".
        "directory.\n"); 
}

# Create an empty file for compiler.
open (TEMP, ">test.c");
print(TEMP "");
close(TEMP);

$ph = FileHandle->new();  # request a new file handle.

# Pipe output to file handle.
if ( !open($ph, "$compiler_exe -c -v -E -dM test.c 2>&1 |") ) {
    unlink("test.c");
    die ("Could not scan compiler output.\n"); 
}

  
scanGccOutput($ph, \$gccVersion, \@sysIncludePaths,
              \@omittedIncludePaths, \@sysDefines);

# The file handle and temp file is not needed anymore
close($ph);
unlink("test.c");

# Check found gcc version again configuration template versions.
# If an exact match is not found configVersion would be the closest match
# selected by the user.
$configVersion = getConfigVersion($compiler,$gccVersion,$toolVersion,$manual);

print("Creating configuration for $compiler($gccVersion) using ".
      "$compiler($configVersion) template.\n");

print("Creating substitute headers.\n");
$currentDir = cwd();
# Get absolute path.
# We checked it existed earlier.

$subheadDir = File::Spec->canonpath($subheadDir); # Absolute path.

# copy the directory structure
makeHeaders($currentDir . "/${compiler}-headers/$toolVersion/$configVersion/headers",
            $subheadDir); 

# Build a list of search paths
getSearchPaths($subheadDir, \@substituteHeaders,0);

print("Substitute headers completed.\n");

print("Configuring compiler personality.\n");
#Before we configure the personality we need the absolute path
$personDir=File::Spec->canonpath($personDir);

configurePersonality($compiler, $configVersion, $subheadDir,
                     $personDir,\@substituteHeaders, \@sysIncludePaths,
                     \@omittedIncludePaths,\@sysDefines,$usePCPaths,
                     $toolVersion,$cygwin,$display);

print("Compiler personality configuration complete.\n");

exit 0;
#####################################################################
# Function : initialise
# Parameters : args - a copy of the command line arguments
# Description : Check command line, extract parameters
#               and prompt if improperly used etc.
# Returns : Com
#           and personality dir.
#               
#####################################################################

sub initialise {
    my $product;
    my $version = 100;      # default to really high version number if not specified
    my $matchedVersion;
    my $compiler;
    my $compiler_exe="";
    my $headerDir="";
    my $personDir;
    my $usePCPaths = 0;
    my $cygwin = 0;
    my $manual = 0;		
    my $display = 0;

    # Use standard library to parse command line.
        # first argument must be the product
    $product=shift(@ARGV);

    GetOptions("version=s" => \$version,           # optional string
               "headers=s"  => \$headerDir,        # optional string
               "personalities=s" => \$personDir,   # compulsory string
               "compiler=s" =>  \$compiler_exe,           # optional compiler 
               "pcpaths"         => \$usePCPaths,  # optional boolean flag
               "manual"  => \$manual,              # run manually	
               "display" => \$display);            # display personality filename


    # Test for compulsory parameters
    if (!defined($product) || !defined($personDir)) {
        usage();
    }

    chomp($product);
    chomp($headerDir);
    chomp($personDir);
    chomp($usePCPaths); 
    chomp($cygwin);

    # compiler should be gcc or g++
    if (("$product" =~ m/^[Qq][Aa][Cc]$/) || 
        ("$product" =~ m/^[Qq][Aa][Cc]\+\+$/) ||
        ("$product" =~ m/^[Qq][Aa][Cc][Pp][Pp]$/)) {

        $product =~ tr /A-Z/a-z/;   # ensure lowercase

        $compiler = ($product eq "qac") ? "gcc" : "g++";
        
        if ("$compiler_exe" eq "")
        {
            $compiler_exe = ($product eq "qac") ? "gcc" : "g++";
        }
        else
        {
            print "compiler=$compiler, executable=$compiler_exe\n";
        }
    }else {
        print(STDERR "The first argument must be the product: qac, qacpp or qac++\n");
        usage();
    }

    # Version is numeric but allow several periods e.g. 4.5.2
    if ($version =~ m/^[0-9]+(\.[0-9]+)*$/) {
        #extract major.minor portion.
        $version =~ m/(^[0-9]+(\.[0-9]+)?)/;
        #print("looking for : $1\n");
        $matchedVersion = findConfigVersion($compiler, $1); # e.g. $1 is 1.4 of 1.4.2 
        if ($matchedVersion == 0) {
            die ("No suitable configurations found for $product $version.\n");
        }
                                
        
    } else {
        print (STDERR "--version is in an invalid format.\n");
        usage();
    }

	# if not header dir specified, use the personality dir
	if ( $headerDir eq "" )
	{
		$headerDir = $personDir;
	}    
    #Check the substitute header directory.
    # must be absolute path
    if ( (substr($headerDir,0,1) ne "/") &&
         (substr($headerDir,1,1) ne ":") )
    { 
        print(STDERR "The substitute header directory must be".
               " an absolute path.\n");
        usage();
    }
    checkDirs($headerDir, "Header");

    #Check the personality directory.
    # must be absolute path
    if ( (substr($personDir,0,1) ne "/") &&
         (substr($personDir,1,1) ne ":") ) 
    { 
        print(STDERR "The personality file directory must be".
               " an absolute path.\n");
        usage();
    }
    checkDirs($personDir, "Personality");

    # if OS is cygwin then ensure -pcpaths set
    if ($^O =~ /cygwin/) {
        $cygwin = 1;
        $usePCPaths = 1;
    }
    
    return ($compiler_exe, $compiler, $matchedVersion, $headerDir, $personDir,$usePCPaths, $cygwin, $manual, $display);
}

# if the header or personality dirs given exist, check they are writable dirs
sub checkDirs()
{
    my $path = $_[0];
    my $name = $_[1];

    if (-e "$path") {
       if(-d "$path" && -W "$path") {
            #do nothing
       } else {
            print(STDERR "The $name directory specified exists ".
                "but it is not a writable directory.\n");
            usage();
        }
    }
}

#####################################################################
# Function : usage
# Parameters : None
# Description : Display usage message and terminate
# Returns : Nothing.
#               
#####################################################################

sub usage()
{
    # die gracefully.
    print "prlgcc version $prlgcc_version\n";
    die("USAGE:prlgcc.pl <qac|qacpp|qac++> -personalities <personality_file_dir>" .
    " [-version <product version no>] [-compiler compiler_exe] [-headers <substitute_header_dir>] [-pcpaths] [-manual] [-display]\n"); 


}


#####################################################################
# Function : findConfigVersion
# Parameters : compiler gcc | g++ 
#              toolver qa c or qa c++ version number.
# Description : Find configuration directories for QA C or QA C++ 
#               that matches the compiler and ver tool version number.
# Returns : Closest matched configuration
#               
#####################################################################

sub findConfigVersion
{
    my $compiler = $_[0];
    my $toolver  = $_[1];
    my $found    = 0;           # true if exact match found
    my $matchedVersion = 0;     # best match.
    my $file;                   # current file / directory
    my $startDir = cwd();       # which directory did we start in
    my $lowestAvailableVer = 0; # Lowest available found version no
    
    chdir("${compiler}-headers");
    foreach $file (glob("*")) {
        if (($file =~ m/^[0-9]+(\.[0-9]+)?/) # valid file / directory name
             && (-d $file)) {                # and is a directory
            
            if (($lowestAvailableVer == 0) || ($lowestAvailableVer > $file)) {
                $lowestAvailableVer = $file;
            }
            
            if ((!$found) && ($file == $toolver)) { # numerically equiv
                $found = 1;
                $matchedVersion = $file;
            }
            
            if ((!$found) && ($file < $toolver) && ($file > $matchedVersion)) { # could be closest match
                $matchedVersion = $file; # but keep searching just in case.
            }
        }
    }
    
    if ($matchedVersion == 0) {
        # No version found <= specified so go for lowest available.
        $matchedVersion = $lowestAvailableVer;
    }
    
    chdir($startDir);
    return $matchedVersion;
}

#####################################################################
# Function : scanGccOutput
# Parameters : ph - file handle to gcc output.
#              gccVersionFoundRef - reference reported gcc version 
#                  stored here.
#              sysPathsRef - reference, system include paths reported
#                  by gcc. 
#              omittedPathsRef - reference, system include paths 
#                  omitted from include path list.
#              definesRef - reference, system macros defined by -D...
# Description : Scan the output of gcc -V ... and extract the version,
#               user include paths (if configured),  system include
#               paths and macros (-Dmacro...)
# Returns : Nothing.
#               
#####################################################################

sub scanGccOutput {
    my $ph = $_[0];
    my $gccVersionFoundRef = $_[1];
    my $sysPathsRef = $_[2];
    my $omittedPathsRef = $_[3];
    my $definesRef = $_[4];
    my $line;
    my $i;
    my $canonicalPath;   #absolute path to directory
    my $macroName;
    my $macroBody;
    my $macroDef;     # PRL style macro definition

    while (defined($line = <$ph>)) {
        chomp($line);

        # Look for the product version
        if ( "$line" =~ /^gcc\s+version\s+([0-9a-zA-Z\.]+)/ ) {
            $$gccVersionFoundRef = $1;
        }

        # Look for pre-processor invocation and extract macro defns
        # ++++ These definitions not used any more ++++
        #if ("$line" =~ m#(/.*)*/cpp#) {
        #    extractDefns($line, $definesRef);
        #
        #}


        # Extract # defines from output and convert to macro=body
        # command line options -E -dM generate implicit defines as
        # #define directives

        # macro with body
        if ( "$line" =~ /^#define\s+(\w[\w\(\)]*)\s+(.*)\s*$/) {

            # $1 = macro name, $2 = macro body
	    $macroName = $1;
	    $macroBody = $2;

            # remove trailing spaces
	    $macroBody =~ s/\s+$//;

            if ("$macroBody" =~ m/\".*\"/ ) {
                # remove the quotes.  __PRL_STRINGIFY will add later.
                $macroBody =~ s/\"//g;
                $macroDef = "${macroName}=_PRL_STRINGIFY(${macroBody})";

            } else {
                $macroDef = "$macroName=$macroBody";
            }

            push(@$definesRef,$macroDef);
	} elsif ( "$line" =~ /^#define\s+(\w+)\s*$/ ) {
        # macro without body
        
        # $1 = macro name
	    push(@$definesRef,"$1=");
	}

        # Look for search paths. @ is match operator.
        if ("$line" =~ m@^#include [<"]\.\.\.[>"] search starts here@) {
            # should be paths until "End of search list"
            while ((defined($line = <$ph>)) &&
                   !("$line" =~ m/^End of search list/)) {

                # Identify paths and store.  Paths are indented.
                if ("$line" =~ m#^\s+([/\.\w\\].*)#) {

                    if (-d "$1") {
                        $canonicalPath = File::Spec->canonpath($1);
                        push(@$sysPathsRef,$canonicalPath);
                    } else {
                        push(@$sysPathsRef, $1);
                    }
                }

            }

            # if we've reached the end of file something is wrong.
            if (!defined($line)) {
                warn("\a\a\a\aWARNING - end of file reached while ".
                     "processing search path list.  ".
                     "The output of gcc -v may be in an unexpected ".
                     "format.\n");
            }
 

        }

        # Look for omitted search paths. @ is match operator.
        #if ("$line" =~ m/omitted from the search path:$/) {
        #    # should be paths until "End of omitted list"
        #    while ((defined($line = <$ph>)) &&
        #           !("$line" =~ m/^End of omitted list/)) {
        #
        #        # Identify paths and store.  Paths are indented.
        #        if ("$line" =~ m#^\s+(/.*)#) {
        #            push(@$omittedPathsRef, $1)
        #        }
        #
        #    }
        #
        #    # if we've reach the end of file something is wrong.
        #    if (!defined($line)) {
        #        warn("\a\a\a\aWARNING - end of file reached while ".
        #             "processing omitted path list.  ".
        #             "The output of gcc -v may be in an unexpected ".
        #             "format.\n");
        #    }
        #
        #}

    }
}    

#####################################################################
# Function : extractDefns
# Parameters : line - line of text containing multiple defns (-D...)
#              definesRef - reference to array to containi definition
#
# Description : scan line for occurances of -D... and extract
#               macro definition into definesRef.
#               
# Returns : Nothing.
#               
#####################################################################

sub extractDefns {
    my $line = $_[0];
    my $definesRef = $_[1];
    my $lineLen = length($line);
    my $defn;                   #temporary store for macro defn.
    my $idx = 0;                #used to index substrings of $line.
    my $oldIdx = 0;             # continue search from this location.


    # while not at the end of the string
    # and there is at least one -D... remaining
    while (($idx < $lineLen) &&
           ((substr($line,$idx) =~ /(-D)(\S+)/)) ||   # eg -D__SYM__=123 
            (substr($line,$idx) =~ /(-D)(\S+=".*")/)) # eg -D__SYM__="ABC"
    {
        # $1 contains -D, $2 contains macro text.
        $defn = $1.$2;
        push(@$definesRef, $2);
        $oldIdx = $idx;   #The next index must be greater than this.
        $idx = index($line,$defn,$oldIdx) + length($defn);
    }


    # Do exactly the same for -A's
    # Format is -AMacro(value)
    #
    #-A's  Skipped in this version
    #$idx = 0;
    #$oldIdx = 0;

    #while (($idx < $lineLen) &&
    #       (substr($line,$idx) =~ /(-A)(\S+)\((\S+)\)/ ) ) {
    #    # $1 contains -A, $2 contains macro name, $3 contains macro value.
    #    push(@$definesRef,"$2=$3");
    #    $defn = "$1$2($3)";
    #    $oldIdx = $idx;
    #    $idx = index($line, $defn, $oldIdx) + length($defn);
    #}
}

#####################################################################
# Function : getConfigVersion
# Parameters : compiler - gcc or g++.#
#
#              userVersion - The version specified by the user on the
#                command line.
#
# Description : Scans {$compiler}-headers directory configuration directories.
#               each directory is named after the version against which
#               the configuration was tested.
#
#               If an exact match isn't found, the user is prompted
#               to select the version which closest matches their
#               setup.
#              
#               

# Returns : Configuration version.  The version which the 
#           configuration template was designed.
#               
#####################################################################

sub getConfigVersion {

    my $compiler    = $_[0];
    my $userVersion = $_[1];
    my $toolVersion = $_[2];
    my $manual      = $_[3];
    my $configVersion;
    my $dir;
    my @supportedVersions;
    my $found = 0;
    my $numfound;
    my $menuNum;     #Menu item number.
    my $i;
    my $choice;
    my $confirm;
    my $base;
    my $dummy;


    foreach $dir (glob("${compiler}-headers/${toolVersion}/*")) {
        ($base,$dummy,$dummy) = fileparse($dir,'');

        if (-e "${compiler}-headers/$toolVersion/$base/person/${compiler}.p_c.tpl") {

            push(@supportedVersions,$base); # directory name without
                                            # ${compiler}-headers/
        }
    }

    for ($i = 0; (($i < @supportedVersions) && (!$found)); $i++) {

        if ($supportedVersions[$i] eq $userVersion) {
	    $configVersion = $userVersion;
            $found = 1;
        }
    }

    if (!$found) {
        $configVersion = versionMenu($compiler,$userVersion,$toolVersion,
                                     \@supportedVersions, $manual);
    }
    return $configVersion;

}

#####################################################################
# Function : versionMenu
# Parameters : compiler - gcc or g++.
#
#              userVersion - The version specified by the user on the
#                command line.
#
#              toolVersion - QA C / C++ version number
#
#              supportedVersionsRef - array of supported version numbers.
#
# Description : Scans gcc-headers directory configuration directories.
#               each directory is named after the version against which
#               the configuration was tested.
#
#               Prompting the user
#               to select the version which closest matches their
#               setup.
#              
#               
# Returns : Configuration version.  The version which the 
#           configuration template was designed.
#               
#####################################################################

sub versionMenu {

    my $compiler = $_[0];
    my $userVersion = $_[1];
    my $toolVersion = $_[2];
    my $supportedVersionsRef = $_[3];
    my $manual = $_[4];
    
    my $found = 0;
    my $numfound;
    my $menuNum;     #Menu item number.
    my $i;
    my $choice=0;
    my $confirm;

    $numfound = @$supportedVersionsRef; # number of versions found.

    # This loop is only entered if we didn't find a matching version above.
    do {
        # Display supported versions.
        print("\n\nVersion $userVersion of your compiler was detected.\n".
              "An exact match for a configuration template was not found\n\n");
        print("Configurations found for $compiler versions:\n".
              "============================================\n");

        for($i=0; $i < $numfound; $i++) {
            $menuNum = $i+1;
            print("$menuNum.\t$$supportedVersionsRef[$i]\n");
        }

	    # if in non-interactive mode, automatically make the choice
	    if (!$manual)
	    {
	    	my @nums;
	    	
	        $choice=0;                          # default choice for versions < min supported
	    	$numfound = @$supportedVersionsRef; # number of versions found.
	    	for($i=$numfound-1; $i>= 0; $i--) 
	        {
	            if (versionGtEq($userVersion, $$supportedVersionsRef[$i]))
	            {
	                $choice =$i;
	                last;
	            }
	        }
	    	$configVersion = $$supportedVersionsRef[$choice];
	        print "\nAutomatically choosing version $configVersion\n";
	        return $configVersion;
	    }   
	    # other wise we let the user chose
	    print("Q.\tQuit configuration.\n\n");
        print("Please select the version which is the closest match for your ".
              "system\n".
              "Enter a number[1..$numfound] or Q to quit: " );
        chomp($choice = <STDIN>);
        
        #if choice is a number and choice is within range
        if (defined($choice)) {
            if ( ($choice =~ m/\d+/) && ($choice >= 0) && 
                ($choice <= $numfound)) {

                # Check if a configuration exists for language / version
                # combination.

                if (-e "${compiler}-headers/$toolVersion/$$supportedVersionsRef[$choice-1]/"
                       ."person/$compiler.p_c.tpl") {
                        $found = 1;
                        $configVersion = $$supportedVersionsRef[$choice-1];
                } else {
                     # Oops we support the version but not the compiler.
                     warn("\n"."+"x 80 ."\n".
                          "WARNING: No configuration template exists for ".
                          "$compiler version ".
                          "$$supportedVersionsRef[$choice-1].".
                          "\n"."+"x 80 ."\n");
		}
            } elsif ($choice =~ m/[Qq]/) {
                # Quit user cannot find an acceptable configuration.
                unlink("test.c");
                $!=1;
                die("\a\aUser aborted configuration.\n");
            }
        }
    } until ($found);

    return $configVersion;
}

#####################################################################
# Function : makeHeaders
# Parameters : source - Source directory
#    
#              dest - Destination directory
#
# Description : Recursively copy header file directories from source
#               to dest in a OS independent manner.
#               
#               THE SOURCE AND DESTINATION DIRECTORIES MUST BE ABSOLUTE PATHS
#               
# Returns : Nothing.
#               
#####################################################################

sub makeHeaders {

    ######  The source and destination paths must be ABSOLUTE PATHS ######
    # This function relies on the fact that "/" is portable as
    # directory separator for internal functions.

    my $source         = $_[0];    # Source directory
    my $dest           = $_[1];    # destination directory

    my $path;     # Path, base and extention extracted from current file.
    my $base;     # eg  /users/username/dir/file.h
    my $ext;      # $path="/users/username/dir", $base ="file", $ext=".h"


    my $file;     # The current file.
    
    my @files;    # all of the files

        # have to glob files differently depending on if there
        # are spaces in the path...
    if (index($source, ' ') == -1)
    {
        @files = <$source/*>;       # no space, no quotes
    }
    else
    {
        @files = <"$source/*">;     # spaces, use quotes
    }

    foreach $file (@files) {
        #parse filename
        ($base, $path, $ext) = fileparse($file,'\..*');

        # if the $file is a directory and we can access...
        if ( (-d $file) && (-X $file) ) {
            # Create the same directory at the destination,
            # add the current destination directory to the 
            # search paths list if it's not already there
            # and recursively call this function.
            if ( !(-d "$dest/$base$ext" ) ) {
                if (! mkpath(["$dest/$base$ext"],0,0777) ) {
                    unlink("test.c");
                    die ("Failed to make dir $dest/$base$ext\n");
                }
            }
            makeHeaders("$file","$dest/$base$ext");
        } elsif (! -d "$file") {
            # Copy the file to the destination directory

            if ( !copy("$file","$dest/$base$ext") ){
                unlink("test.c");
                die ("Failed copying $file to $dest/$base$ext");
            }

        }

    }
}

#####################################################################
# Function : getSearchPaths
# Parameters : subHeadDir - root level directory for substiture headers
#    
#              substituteHeaders - Reference to array in which substitute
#              headers will be stored
#
#              skipLeafDirs - if true ignore directories which contain
#                             other directories.
#
# Description : Recursively scan the substitute header directories and build
#               a list of non-leaf level directories.
#               
#               THE DIRECTORY MUST BE AN ABSOLUTE PATH
#               
# Returns : Nothing.
#               
#####################################################################

sub getSearchPaths {
    my $subHeadDir           = $_[0];
    my $substituteHeadersRef = $_[1];
    my $skipLeafDirs         = $_[2];

    my $file;           # The current file.
    my $currentPath;    # The current directory
    my $canonicalPath;  # platform dependent canonical path.
    my @files;          # all files

        # handle spaces in dir name
    if (index($subHeadDir, ' ') == -1)
    {
        @files = <$subHeadDir/*>;       # no space, no quotes
    }
    else
    {
        @files = <"$subHeadDir/*">;     # spaces, use quotes
    }

    foreach $file (@files) {
        if ( (-d "$file") &&
             (-X "$file")) {
            
            # If this dir does not contain files put it in the search path
            if ((!$skipLeafDirs) ||                      # we don't care if the dir is a leaf or not
               ($skipLeafDirs && (!isLeafDirectory("$file")))) {  # or we do care and this directory is not a leaf

                $canonicalPath = File::Spec->canonpath("$file");

                push(@$substituteHeadersRef, $canonicalPath);
            }
            getSearchPaths("$file", $substituteHeadersRef,1); # Note only dirs without files from now on
        }
    }
}

#####################################################################
# Function : isLeafDirectory
# Parameters : directory - path to directory.
#
# Description : True if directory does not contain any subdirectories
#               
#               THE DIRECTORY MUST BE AN ABSOLUTE PATH
#               
# Returns : Non-zero if the directory contains a non-directory file
#               
#####################################################################

sub isLeafDirectory {
    my $dir  = $_[0];
    my $file;
    
    foreach $file (<$dir/*>) {
        if ( -d $file) {
            return 0;
        }
    }
    
    return 1;
}


#####################################################################
# Function : configurePersonality
# Parameters : compiler - gcc or g++
#    
#              version - compiler version e.g. 3.0
#
#              subHeadDir - location of substitute headers.
#                  Absolute path.
#
#              personDir - location to place the compiler personality.
#                  Absolute path.
#
#              subHeadRef - Reference. Array of substitute header paths.
#
#              sysPathsRef - Reference. Array of system include paths.
#
#              omittedRef - Reference. Array of omitted system include paths.
#
#              sysDefinesRef - Reference. Array of system macros.
#
#              toolVErsion - QA C / C++ version number.
#
# Description : configure a compiler personality based on a template.
#               The template is copied as is, with the retrieved
#               information inserted at the indicated points.
#               
#               
# Returns : Nothing.
#               
#####################################################################

sub configurePersonality {

    my $compiler      = $_[0];
    my $version       = $_[1];
    my $subHeadDir    = $_[2];
    my $personDir     = $_[3];
    my $subheadRef    = $_[4];
    my $sysPathsRef   = $_[5];
    my $omittedRef    = $_[6];
    my $sysDefinesRef = $_[7];
    my $usePCPaths    = $_[8];
    my $toolVersion   = $_[9];
    my $cygwin        = $_[10];
    my $display       = $_[11];
    
    my $tool = ($compiler eq "gcc") ? "qac" : "qacpp";
    
    my $templatePath = 
            "${compiler}-headers/$toolVersion/$version/person/${compiler}.p_c.tpl";
    my $line;        # Current line of template.
    my $item;        # Used to iterate over lists.
    my $pcPath;      # paths converted to PC format.
    my $cygwinRoot = ""; # cygwin root path
    my $useCygpath = 1;  # flag for wheather to use cygpath or mount method
    my %cygwinMountPoints;
    my @mounts;
    
    ######################################################
    # The following variables are set to the appropriate
    # syntax depending on if the personality is for QAC
    # or QAC++.
    ######################################################

    my $forceInclude;
    my $quiet;
    my $systemInclude;
    my $systemDefine;
    my $optionalQuote;  # Quote system define for QAC, not for QAC++

    my $pathSeparator;  # Use \ on PC systems where --pcpaths is specified.

    if ($cygwin) {
        # see if we have cygpath and use that if possible as this
        # gives best results, otherwise check mounts
        my $tmp=`which cygpath`;
        chomp($tmp);
        if ($tmp eq "" )
        {
            $useCygpath = 0;
            # If the OS is cygwin replace cygwin mount points
            # Thanks to Dedicated Systems for this improvement
            %cygwinMountPoints = getCygwinMountPoints(\$cygwinRoot);
            @mounts = sort {$b cmp $a } keys %cygwinMountPoints;


            # translate all cygwin mount points to PC path entries
            foreach my $mount ( @mounts )
            {
                my $cygwinPath = $mount;
                my $PCpath = $cygwinMountPoints{$mount};
	    
	            foreach $item (@$omittedRef) 
                {
                    $item =~ s/^$cygwinPath/$PCpath/;
                }
            
                foreach $item (@$sysPathsRef) 
                {
                    $item =~ s/^$cygwinPath/$PCpath/;
                }
            }
            
            # If any paths still start with "/" prepend $cygwinRoot
            # $cygwinRoot should be returned as a reference from 
            # getCygwinMountPoints()
    
            foreach $item (@$omittedRef) {
                $item =~ s#^/#$cygwinRoot#;
            }
            
            foreach $item (@$sysPathsRef) {
                $item =~ s#^/#$cygwinRoot#;
            }
            # and the same for sub headers
            foreach $item (@$subheadRef) {
                $item =~ s#^/#$cygwinRoot#;
            }
        }
        else
        {
                # use cypath
            foreach $item (@$omittedRef) {
                $item=`cygpath -w "$item"`;
                chomp($item);
            }
        
            foreach $item (@$sysPathsRef) {
                $item=`cygpath -w "$item"`;
                chomp($item);
            }
                # and the same for sub headers
            foreach $item (@$subheadRef) {
                $item=`cygpath -w "$item"`;
                chomp($item);
            }
        }
    } # if ($cygwin) ...

    if ($usePCPaths) 
    {
        $pathSeparator = "\\";
	
        # convert all path entries to PC format.  (Match op is #)
        foreach $item (@$subheadRef) 
        {
             $item =~ s#/#$pathSeparator#g;
        }

        foreach $item (@$omittedRef) 
        {
            $item =~ s#/#$pathSeparator#g;
        }

        foreach $item (@$sysPathsRef) 
        {
            $item =~ s#/#$pathSeparator#g;
        }
    } else {
        $pathSeparator = "/";
    } 

    if ($compiler eq "gcc") {
        # QAC personality
        $forceInclude="-fi";
        $quiet="-q";
        $systemInclude="-i";
        $systemDefine="-d";
        $optionalQuote="\"";
    } else {
        # QAC++ personality
        $forceInclude="-fi";
        $quiet="-q";
        $systemInclude="-si";
        $systemDefine="-sd";
        $optionalQuote="\"";
    }

    if (! open (SOURCE,"<$templatePath")) {
        unlink("test.c");
        die("Failed to open template $templatePath");
    }

    if (! open (DEST, ">$personDir/${compiler}_v${version}_${tool}${toolVersion}.p_c")) {
        unlink("test.c");
        die("Failed to create $personDir/${compiler}_v${version}_${tool}${toolVersion}.p_c");
    }

    while (defined ($line = <SOURCE>)) {
        # copy each line of the template and check for indicators.

        print(DEST $line);

        # substitute headers
        if ($line =~ /^\*\s*substitute\s*headers.*/i) {
            # if a forceinclude file exists in the root of the
            # header file destination.  Then generate a forceinclude.
            # add force includes for all files in this dir.

            # if any other headers live in the prlforceinclude list then add these as well
            # not just the prlgcc/g++ file
            my $writeQuietOption=0;
            my $forceIncFile;
            my @files;          # all files

                # handle spaces in dir name
            if (index($subHeadDir, ' ') == -1)
            {
                @files = <$subHeadDir/prlforceinclude/*.h>;       # no space, no quotes
            }
            else
            {
                @files = <"$subHeadDir/prlforceinclude/*.h">;     # spaces, use quotes
            }

                # add all files in the force include directory
            foreach $forceIncFile (@files) {
                    # translate all cygwin mount points to PC path entries
                if ($cygwin) {
                    if($useCygpath == 1)
                    {
                        $forceIncFile=`cygpath -w "$forceIncFile"`;
                        chomp($forceIncFile);
                    }
                    else
                    {
                        foreach my $mount ( @mounts )
                        {
                            my $cygwinPath = $mount;
                            my $PCpath = $cygwinMountPoints{$mount};
	                
                            $forceIncFile =~ s/^$cygwinPath/$PCpath/;
                        }
                    }
                } 
                if ($usePCPaths) {
                    $forceIncFile =~ s#/#$pathSeparator#g;
                        # set path parsing rules for creating quiet directory
                        # directly from force include file
                    fileparse_set_fstype("MSWin32");
                }
                    # write quiet option once, 
                if ($writeQuietOption == 0 ) { 
                        # get path component, write and set flag
                    my $quietDir = dirname($forceIncFile);
                    print(DEST "$quiet \"$quietDir\"\n");
                    $writeQuietOption = 1;
                }  
                    # write the force include option last, so they all appear together
                print(DEST "$forceInclude \"$forceIncFile\"\n");
            }
                      

            # insert the substitute header list.
            foreach $item (@$subheadRef) {

                # Don't repeat the prlforceinclude directory
                if (!($item =~ "prlforceinclude")) {

                    print(DEST "$systemInclude \"$item\"\n");
                }
            }

            # again for -quiet includes
            # This could be done in the loop above but kept separate
            # to make the personality file easier to read.
            foreach $item (@$subheadRef) {
                # Don't repeat the prlforceinclude directory
                if (!($item =~ "prlforceinclude")) {

                    print(DEST "$quiet \"$item\"\n");
                }
            }
        }


        # gcc include directories or CR 965 #include_next difficiency

        if (($line =~ /^\*\s*gcc\s*include\s*directories.*/i) ||
            ($line =~ /^\*\s*cr\s*965.*/i)) {

            foreach $item (@$omittedRef) {

                print(DEST "$systemInclude \"$item\"\n");
            }

            foreach $item (@$sysPathsRef) {

                print(DEST "$systemInclude \"$item\"\n");
            }

            # do -quiet includes for include directories.
            if ($line =~ /^\*\s*gcc\s*include\s*directories.*/i) {
                foreach $item (@$omittedRef) {

                    print(DEST "$quiet \"$item\"\n");
                }

                foreach $item (@$sysPathsRef) {

                    print(DEST "$quiet \"$item\"\n");
                }

            }
        }


        # Implicit macros
        if ($line =~ /^\*\s*implicit\s*macros.*/i) {
            print(DEST "$systemDefine ${optionalQuote}_PRL_STRINGIFY(x)=#x".
                       "$optionalQuote\n");
            foreach $item (@$sysDefinesRef) {

                print(DEST "$systemDefine $optionalQuote$item" .
                           "$optionalQuote\n");
            }
        }
    }

    close(SOURCE);
    close(DEST);
    if ($display != 0)
    {
        print("[[$personDir/${compiler}_v${version}_${tool}${toolVersion}.p_c]]\n");
    }
}

#####################################################################
# Function : getCygwinMountPoints
# Parameters : cygwinRootRef - when the pc path to the cygwin root is
#               found it is stored here for use later in
#               mapping cygwin paths to pc paths
#
# Description : Map cygwin mount points by capturing the output of 
#               the cygwin mount command
#               information inserted at the indicated points.
#               Extracts paths from lines such as
#               c: on /cygdrive/c type user (textmode,noumount)
#               C:\cygwin\bin on /usr/bin type ntfs (binary,auto)
#               Note from Cygwin 1.7 the mount command reports:
#               C:/cygwin/bin on /usr/bin type ntfs (binary,auto)
#               i.e. with forward slashes, so the regex now does both
#               
# Returns : Map of cygwin mounts.  Key is cygwin path
#               
#####################################################################
sub  getCygwinMountPoints
{
    my $cygwinRootRef = $_[0];
    my %cygwinMountPoints = ();
    my @mountOutput = `mount`;
    my $line;

    foreach $line (@mountOutput)
    {
        # Look for search paths. @ is match operator.
   
        if ( "$line" =~ m@^([a-z:\\/]+)\s+on\s+([a-zA-Z0-9/]*)\s@  ||
             "$line" =~ m@^([a-zA-Z0-9:\\/]+)\s+on\s+([/])\s@) # root 
	{
	    my $PCpath = $1;
	    my $cygwinPath = $2;
	    
	    # the root mount needs a "\" added
	    if ( $cygwinPath =~ m@^[/]$@ )
	    {
            # Make a note of this path and pass back as ref
               $PCpath = $PCpath."\\";
               $$cygwinRootRef = $PCpath;
        }  

#	    printf "%-20s mounted at %s\n\n", $cygwinPath, $PCpath;
	    
            $cygwinMountPoints{ $cygwinPath } = $PCpath;
        }
    }

    return %cygwinMountPoints;
}
# Chop up a version number into Major.Minor.Release components
sub getVersions
{
    my $ver = $_[0];
    my $maj="0";
    my $min="0";
    my $rel="0";
    my @nums;
    my $len;
    
    @nums = split(/\./, $ver);
    $len = @nums;
    if($len > 0)
    {
        $maj = $nums[0];
    }
    if($len > 1)
    {
        $min = $nums[1];
    }
    if($len > 2)
    {
        $rel = $nums[2];
    }
    return ($maj, $min, $rel);
}
#return 1 if the the version on lhs is greater than or equal to rhs
sub versionGtEq
{
    my $lhs = $_[0];
    my $rhs = $_[1];
    
    my $lhsmaj;
    my $lhsmin;
    my $lhsrel;
    my $rhsmaj;
    my $rhsmin;
    my $rhsrel;
    ($lhsmaj, $lhsmin, $lhsrel) = getVersions($lhs);
    ($rhsmaj, $rhsmin, $rhsrel) = getVersions($rhs);
    
    if ($lhsmaj > $rhsmaj)
    {
        return 1;
    }
    if ($lhsmaj < $rhsmaj)
    {
        return 0;
    }
    # majors the same, check minor
    if ($lhsmin > $rhsmin)
    {
        return 1;
    }
    if ($lhsmin < $rhsmin)
    {
        return 0;
    }
    #minor same, check rel
    if ($lhsrel > $rhsrel)
    {
        return 1;
    }
    if ($lhsrel < $rhsrel)
    {
        return 0;
    }
    # rel same, return true
    return 1;
}
