#!/usr/bin/perl
########################################################################
#
# CTC++ System, absagentinis2pm (v1.0)
# absagentinis.pm creator, part of ctcwrap -hard ... toolchain
#
# This script can be run when doing setup on ctcwrap -hard ... arrangement.
# This script reads files that are given in command line. They are assumed to
# be CTC++ .ini files. Each file is parsed and conf parameters COMMAND ...
# are identified. Mapping data: which compile commad is described in what .ini
# file is derived. It is written to %CTCHOME%\absagentinis.pm Perl module.
# That Perl module is used, if exists and has mapping on the command at hand,
# in ctcwrap -hard ... toolchain (in absagent.pl) for specifying the .ini
# file for the compile command at hand
#
# RCSfile     : $RCSfile: absagentinis2pm.pl $
# Version     : $Revision: 1.1 $ $Date: 2011/05/22 13:14:50 $
# Last Edited : 22.05.2011
# Author      : $Author: jorma $
#
#                  Copyright (c) 2011 Testwell Oy
##########################################################################

##########################################################################
# subroutines
##########################################################################
sub genit;
sub dirname;
sub basename;

##########################################################################
# execution starts here !
##########################################################################
genit(@ARGV);

1;

# The program execution ends here. The definitions of the subroutines
# follow.

##########################################################################
# SUBROUTINES
##########################################################################

##########################################################################
# SUBROUTINE: genit
# PARAMETERS: @_ (use @ARGV)
# PURPOSE   : Generates %CTCHOME%\absagentinis.pm 
# NOTE      : This overwrites unconditionally
##########################################################################
sub genit {
    $sep='/';
    $sep='\\' if $^O eq "MSWin32";
    
    $found=0;
    
    foreach $ini (@_) { # input .ini files are command line arguments
        # file must end on ".ini", i.e. skip e.g. edit backups like .ini~
        if ($ini=~/ini$/i) {
            $ini=basename($ini);
            open INI, $ENV{CTCHOME}.$sep.$ini;
            while (<INI>) { # read one .ini file
                # .ini file continuation lines and unix/dos style line ends
                s/\015?\012$//;
                while (!eof(IN) && /\\$/) {
                    $_=~s/\\$//;
                    $_.=<IN>;
                    s/\015?\012$//;
                }
                s/^([^#]*)#.*/$1/;
                if (/COMMAND\s*[=+](.*)/) {
                    my @list = split(/,/,$1);
                    foreach (@list) { # compilers in COMMAND
                        s/^\s*//;s/\s*$//;  # trim whitespace
                        s/^"//;s/"$//;      # remove "quotes"
                        s/^'//;s/'$//;      # remove 'quotes'
                        unless (/-orig/ or
                            /-orig.exe/) {
                            $ini{$_}=$ini;
                            $found++;
                        }
                    }
                }
            }
            close INI;
        }
    }

    if ($found) {
        # wqrite the mapping file (perl module)
        open OUT, ">".$ENV{CTCHOME}.$sep."absagentinis.pm";
        print OUT "#!/usr/bin/perl\n"; 
        foreach $key (keys %ini) {
            if (!length($key)) {
                # Insanity checks, we comment out
                print OUT "# "; 
            }
            print OUT "\$ini{\"$key\"} = \"".$ini{$key}."\";\n";
        }
        close OUT;
    }
}


##########################################################################
# SUBROUTINE: dirname
# PURPOSE   : Returns the directory part of a filename
##########################################################################
sub dirname
{
    my ($filename) = @_;
    my $dir = "";
    my $end;

    $end = rindex $filename, '\\';
    if ((rindex $filename, '/') > $end) {
       $end = rindex $filename, '/';
    }
    if ($end > 0) {
        $dir = substr $filename, 0, $end;
    } elsif ($end == 0) {
        $dir = substr $filename, 0, 1;
    }
    return $dir;
}


##########################################################################
# SUBROUTINE: basename
# PURPOSE   : Strip directory from a filename
##########################################################################
sub basename 
{
    my ($filename) = @_;
    my $base = $filename;
    my $end;

    $end = rindex $filename, '\\';
    if ((rindex $filename, '/') > $end) {
       $end = rindex $filename, '/';
    }
    if ($end >= 0) {
       $base = substr $filename, $end + 1;
    }
    return $base;
}