#!/perl -w
# NAME: msvc8incs.pl
# AIM: Show content of MSVC8 'configuration' file ...
use strict;
use warnings;
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
    my @tmpsp = split(/\\/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = "temp.$pgmname.txt";
open_log($outfile);

my $in_file = 'C:\Program Files\Microsoft Visual Studio 8\VC\vcpackages\VCProjectEngine.Dll.Express.Config';
my $vc_common = $ENV{VS80COMNTOOLS};
my $vc_include = $ENV{INCLUDE};
my $vc_lib = $ENV{LIB};
my $got_include = 0;
my $got_lib = 0;

my $vc_vars = 'C:\Program Files\Microsoft Visual Studio 8\VC\bin\vcvars32.bat';
if ($vc_common && length($vc_common)) {
    $vc_vars = $vc_common;
    $vc_vars .= "\\" if !($vc_vars =~ /[\\\/]$/);
    $vc_vars .= 'vsvars32.bat';
}

###"\$(FrameworkSDKDir)include",
my @inc_locations = ( "C:\\Program Files\\Microsoft Visual Studio 8\\VC\\include",
"C:\\Program Files\\Microsoft Platform SDK for Windows Server 2003 R2\\Include",
"C:\\Program Files\\Microsoft DirectX SDK (October 2006)\\Include",
"C:\\Program Files\\Microsoft Platform SDK for Windows Server 2003 R2\\Include\\mfc",
"C:\\Program Files\\Microsoft Platform SDK for Windows Server 2003 R2\\Include\\atl",
"C:\\Program Files\\Microsoft Speech SDK 5.1\\Include" );

my @warnings = ();

# DEBUG
my $dbg_v01 = 0;    # show each BAT line - prt( "$line
my $dbg_v02 = 0;    # show each XML lien - prt( "$xmlln: $line
my $dbg_v03 = 0;

if ($vc_include && length($vc_include)) {
    prt( "Got ENV INCLUDE = $vc_include\n" );
    $got_include = 1;
} else {
    $got_include = 0;
    prt( "NO ENV INCLUDE!\n" );
}

if ($vc_lib && length($vc_lib)) {
    prt( "Got ENV LIB = $vc_lib\n" );
    $got_lib = 1;
} else {
    $got_lib = 0;
    prt( "NO ENV LIB!\n" );
}

my %vc_hash = get_vc_vars($vc_vars);

show_vc_hash( \%vc_hash );

my %xml_hash = get_xml_file_hash($in_file, \%vc_hash);

show_x_hash( \%xml_hash );

show_inc_array( \@inc_locations );

show_warnings();

close_log($outfile,1);
exit(0);

#################
### SUBS ONLY ###

sub show_inc_array {
    my ($ir) = shift;
    my ($itm, $ok, $cnt);
    $cnt = scalar @{$ir};
    prt( "\nINCLUDE locations ($cnt) ...\n" );
    foreach $itm (@{$ir}) {
        $ok = ((-d $itm) ? "ok" : "NOT FOUND");
        prt( "$itm $ok\n" );
    }
}

sub show_x_hash {
    my ($hr) = shift;
    my $cnt = scalar keys(%{$hr});
    prt( "\nShow of $cnt key in hash ...\n" );
    my ($key, $val, @arr, $item);
    foreach $key (keys %{$hr} ) {
        $val = $$hr{$key};
        @arr = split(';',$val);
        $cnt = scalar @arr;
        prt( "KEY [$key] - $cnt items ...\n" );
        foreach $item (@arr) {
            prt( "             $item\n" );
        }
    }
}


sub show_vc_hash {
    my ($hr) = shift;
    my ($key, $val);
    foreach $key (keys %{$hr}) {
        $val = $$hr{$key};
        prt( "HK: $key = $val\n" );
    }
}


sub expand_env_variables {
    my ($txt) = shift;
    my @arr = split(';',$txt);
    my ($cnt, $i, $val, $var);
    $cnt = scalar @arr;
    my @narr = ();
    my %h;
    for ($i = 0; $i < $cnt; $i++) {
        $val = $arr[$i];
        if ($val =~ /^\%(.+)\%$/) {
            $var = $1;
            prt("CHECK ENVIRONMENT for [$var] - ");
            if ( exists ($ENV{$var}) ) {
                $val = $ENV{$var};
                prt( "Using [$val]\n" );
            } else {
                prt( "NOT FOUND\n" );
                next;
            }
        }
        $h{$val} = 1;
    }
    @narr = keys(%h);
    $txt = join(';',@narr);
    return $txt;
}

sub compare_hash_values {
    my ($key, $val, $rh) = @_;
    my $cv = $$rh{$key};
    if ($cv eq $val) {
        return 0;
    }
    my ($i1, $i2, $cnt, $i, $var);
    my @a1 = split(';',$cv);
    my @a2 = split(';',$val);
    my @cb = ();
    my %h = ();
    $cnt = scalar @a1;
    for ($i = 0; $i < $cnt; $i++) {
        $i1 = $a1[$i];
        ##if ($i1 =~ /^\$\((.+)\)$/) {
        if ($i1 =~ /^\%(.+)\%$/) {
            $var = $1;
            prt("Checking ENVIRONMENT for [$var] - ");
            if ( exists ($ENV{$var}) ) {
                $i1 = $ENV{$var};
                prt( "Using [$i1]\n" );
            } else {
                prt( "NOT FOUND\n" );
                next;
            }
        }
        if (!defined $h{$i1}) {
            $h{$i1} = 1;
        }
    }
    $cnt = scalar @a2;
    for ($i = 0; $i < $cnt; $i++) {
        $i1 = $a2[$i];
        if ($i1 =~ /^\%(.+)\%$/) {
            $var = $1;
            prt("Checking ENVIRONMENT for [$var] - ");
            if (exists($ENV{$var}) ) {
                $i1 = $ENV{$var};
                prt( "Using [$i1]\n" );
            } else {
                prt( "NOT FOUND\n" );
                next;
            }
        }
        if (!defined $h{$i1}) {
            $h{$i1} = 1;
        }
    }
    @cb = keys(%h);
    $i2 = join(';',@cb);
    $$rh{$key} = $i2;
    return 0;
}


sub get_vc_vars {
    my ($inf) = shift;
    my (@lines, $line, $lncnt);
    my ($item, @arr, $key, $val);
    my ($tline);
    my %hash = ();
    if (open INF, "<$inf") {
        @lines = <INF>;
        close INF;
        $lncnt = scalar @lines;
        prt( "Processing $lncnt lines from [$inf]...\n" );
        foreach $line (@lines) {
            chomp $line;
            $tline = trim_all($line);
            next if (length($tline) == 0);
            if ($line =~ /\@*SET\s+(.+)$/i) {
                $item = $1;
                @arr = split('=',$item);
                if (scalar @arr == 2) {
                    $key = $arr[0];
                    $val = $arr[1];
                    if (defined $hash{$key}) {
                        if (compare_hash_values($key, $val, \%hash)) {
                            prtw("WARNING: $key already exists ...\n");
                            $hash{$key} .= '|'.$val;
                        }
                    } else {
                        $hash{$key} = expand_env_variables($val);
                    }
                } else {
                    prt( "SET $item - CHECK\n" );
                }
            } elsif ($line =~ /\@*REM\s*/i) {
                # skip REM lines
            } else {
                prt( "$line\n" ) if ($dbg_v01);
            }
        }
    } else {
        prtw("WARNING: Unable to open [$inf]!\n");
    }
    return %hash;
}


sub xml_to_lines {
    my ($rlm, @lns) = @_;
    my $intag = 0;
    my $text = '';  # gather TEXT between tags
    my @nlines = ();
    my ($fln, $ln, $ch, $pch, $nch, $len, $i, $i2, $tag, $xml, $dnx);
    my ($lnnm, $lnb, $nlnm);
    my ($ppch, $incomm);
    my $show_comm_dbg = 0;
    $pch = '';
    $ppch = '';
    $nch = '';
    $tag = '';
    $xml = '';
    $dnx = 0;
    $lnnm = 0;
    $nlnm = 0;
    $lnb = 0;
    $incomm = 0;
    $text = ''; # start NO TEXT
    foreach $fln (@lns) {
        chomp $fln;
        $ln = trim_all($fln);
        $len = length($ln);
        $lnnm++;    # count another xml line
        for ($i = 0; $i < $len; $i++) {
            $i2 = $i + 1;
            $ch = substr($ln,$i,1);
            $nch = (($i2 < $len) ? substr($ln,$i2,1) : ' ');
            if ($intag) {
                # on first GREATER THAN - SPACE
                $tag .= $ch;
                if ($ch eq '>') {
                    if ( $incomm ) {
                        prt("$lnnm: potential end of XML tag pch=$pch ppch=$ppch\n") if ($show_comm_dbg);
                        if (($pch eq '-') && ($ppch eq '-')) {
                            $nlnm++;
                            push(@nlines,$tag);
                            ### prt( "push(\@xlnmap, [ $nlnm, $lnb, $lnnm ]); # each NEW line has BEGIN and END\n" );
                            $$rlm{$nlnm} = "$lnb-$lnnm";    # each NEW line has BEGIN and END
                            $tag = '';
                            $intag = 0;
                            $xml = '';
                            $incomm = 0;
                            prt( "$lnnm: Exit comment [$ln]\n" ) if ($show_comm_dbg);
                        }
                    } else {
                        $nlnm++;
                        push(@nlines,$tag);
                        ### prt( "push(\@xlnmap, [ $nlnm, $lnb, $lnnm ]); # each NEW line has BEGIN and END\n" );
                        $$rlm{$nlnm} = "$lnb-$lnnm";    # each NEW line has BEGIN and END
                        $tag = '';
                        $intag = 0;
                        $xml = '';
                        $incomm = 0;
                    }
                }
            } else {
                if ($ch eq '<') {
                    if (length($text)) {
                        $nlnm++;
                        push(@nlines,$text);
                        $$rlm{$nlnm} = "$lnb-$lnnm";    # each NEW line has BEGIN and END
                        $text = '';
                    }
                    $tag = $ch; # start a tag line
                    $intag = 1; # signal in a tag
                    $xml = '';
                    $dnx = 0;
                    $lnb = $lnnm;    # set the BEGIN xml line
                    if ($nch eq '!') {
                        # but watch out for <!DOCTYPE ...>
                        if ($ln =~ /<!--/) {
                            prt( "$lnnm: Entering comment [$ln]\n" ) if ($show_comm_dbg);
                            $incomm = 1;
                        }
                    }
                } else {
                    $text .= $ch;
                }
            }
            $ppch = $pch;
            $pch = $ch;
        }
        # done a line - this is like a SPACE
        if ($intag && length($tag)) {
            $tag .= ' ' if !($tag =~ /(=|\s)$/);
        }
    }
    prtw("WARNING: Exit STILL in comment!\n") if ($incomm);
    if (length($tag)) {
        prtw("WARNING: xml re-lining error! Left pending tag [$tag]\nin $in_file file ...\n");
    }
    return @nlines;
}

# this could be split(/\s/,$line), but there is a
# problem with name="with space", that this overcomes.
# Slower. but sure the split is as desired.
sub space_split {
	my ($lin) = shift;
	my $ll = length($lin);
	my $tag = '';
	my @rarr = ();
	my $inquots = 0;
	for (my $p = 0; $p < $ll; $p++) {
		my $ch = substr($lin,$p,1);
		if ($inquots) {
			$tag .= $ch;
			if ($ch eq '"') {
				$inquots = 0;
			}
		} else {
			if ($ch =~ /\s/) {
				push(@rarr, $tag) if (length($tag));
				$tag = '';
			} else {
				$tag .= $ch;
				if ($ch eq '"') {
					$inquots = 1;
				}
			}
		}
	}
	push(@rarr, $tag) if (length($tag));
	return @rarr;
}

sub array_2_hash_on_equals {
	my (@inarr) = @_;
	my %hash = ();
	my ($itm, @arr, $key, $val, $al, $a);
	foreach $itm (@inarr) {
		@arr = split('=',$itm);
		$al = scalar @arr;
		$key = $arr[0];
		$val = '';
		for ($a = 1; $a < $al; $a++) {
			$val .= '=' if length($val);
			$val .= $arr[$a];
		}
		if (defined $hash{$key}) {
			prtw( "WARNING: array_2_hash_on_equals: Duplicate KEY: [$key] ... ADDING val [$val]\n" );
			$hash{$key} .= "@".$val;
		} else {
			$hash{$key} = $val;
		}
	}
	return %hash;
}

sub strip_quotes {
	my ($ln) = shift;
	if ($ln =~ /^".*"$/) {
		$ln = substr($ln,1,length($ln)-2);
	}
	return $ln;
}

sub cased_hash_var {
    my ($var, $hr) = @_;
    my $lvar = lc($var);
    my @arr = keys %{$hr};
    foreach my $ky (@arr) {
        if (lc($ky) eq $lvar) {
            return $ky;
        }
    }
    return $var;
}


sub get_xml_file_hash {
    my ($inf, $hr) = @_;
    my (@lines, $line, $xmlln, @arr, $max, $i, $item, $tag);
    my (@attribs, %atthash, $key, $val, $j, $cnt, $var, $sub, $chg, $oitem, $ukey);
    my %lnmap = ();
    my $lnnum = 0;
    my $savedb = $dbg_v03;
    my %hash = ();
    if (open INF, "<$inf") {
        @lines = <INF>;
        close INF;
        @lines = xml_to_lines(\%lnmap, @lines);
        $lnnum = 0;
        foreach $line (@lines) {
            $lnnum++;
            $xmlln= $lnmap{$lnnum};
            chomp $line;
            @attribs = space_split($line);
            prt( "$xmlln: $line\n" ) if ($dbg_v02);
            $max = scalar @attribs;
            $tag = $attribs[0];
            if ($tag =~ /^<Directories/) {
                %atthash = array_2_hash_on_equals(@attribs);
                prt( "Directories list ...\n" );
                $chg = 0;
                foreach $key (keys %atthash) {
                    $val = strip_quotes($atthash{$key});
                    @arr = split(';',$val);
                    $cnt = scalar @arr;
                    # do substitutions, if any
                    for ($j = 0; $j < $cnt; $j++) {
                        $item = $arr[$j];
                        $oitem = $item;
                        $dbg_v03 = 1 if ($oitem =~ /FrameworkDir/i);
                        ###if ( $item =~ /\$\((.+)\)+/ ) {
                        if ( $item =~ /\$\((\w+)\)+/ ) {
                            $var = $1;
                            my $cvar = cased_hash_var($var, $hr);
                            prt( "Checking for [$var] ($cvar) in hash ref...\n" ) if ($dbg_v03);
                            if ( defined $$hr{$cvar} ) {
                                $sub = $$hr{$cvar};
                                $sub .= "\\" if !($sub =~ /\\$/);
                                prt("SUB: From [$item] to [$sub]\n") if ($dbg_v03);
                                $item =~ s/\$\($var\)/$sub/;
                                $arr[$j] = $item;
                                $chg++;
                            } elsif (exists $ENV{$var}) {
                                $sub = $ENV{$var};
                                $item =~ s/\$\($var\)/$sub/;
                                $arr[$j] = $item;
                                $chg++;
                            } else {
                                prtw( "SUB OF [$oitem] NOT FOUND!\n" );
                            }
                        }
                        $dbg_v03 = $savedb if ($oitem =~ /FrameworkDir/i);
                    }
                    if ($chg) {
                        $val = join(';',@arr);
                        $atthash{$key} = $val;
                    }
                }
                $chg = 0;
                foreach $key (keys %atthash) {
                    $val = strip_quotes($atthash{$key});
                    @arr = split(';',$val);
                    $cnt = scalar @arr;
                    # do substitutions, if any
                    for ($j = 0; $j < $cnt; $j++) {
                        $item = $arr[$j];
                        $oitem = $item;
                        if ( $item =~ /\$\((\w+)\)/ ) {
                            $var = $1;
                            my $cvar = cased_hash_var($var, $hr);
                            prt( "Checking for [$var] ($cvar) in hash ref...\n" ) if ($dbg_v03);
                            if ( defined $$hr{$cvar} ) {
                                $sub = $$hr{$cvar};
                                $sub .= "\\" if !($sub =~ /\\$/);
                                prt("SUB: From [$item] to [$sub]\n") if ($dbg_v03);
                                $item =~ s/\$\($var\)/$sub/;
                                $arr[$j] = $item;
                                $chg++;
                            }
                        }
                    }
                    if ($chg) {
                        $val = join(';',@arr);
                        $atthash{$key} = $val;
                    }
                }
                foreach $key (keys %atthash) {
                    $val = strip_quotes($atthash{$key});
                    @arr = split(';',$val);
                    $cnt = scalar @arr;
                    $ukey = uc($key);
                    for ($j = 0; $j < $cnt; $j++) {
                        $item = $arr[$j];
                        $item .= "\\" if !($item =~ /\\$/);
                        $sub = ((-d $item) ? "ok" : "NOT FOUND");
                        if ($j == 0) {
                            prt( " Key $ukey = $item $sub\n" );
                        } else {
                            prt("       $item $sub\n");
                        }
                        if ($sub eq 'ok') {
                            if (defined $hash{$ukey}) {
                                $hash{$ukey} .= ';'.$item;
                            } else {
                                $hash{$ukey} = $item;
                            }
                        }
                    }
                }
            } else {
                prt( "Other $max item list ...\n" );
                for ($i = 0; $i < $max; $i++) {
                    $item = $attribs[$i];
                    prt( "   $item\n");
                }
            }
        }
    }
    return %hash;
}

sub prtw {
	my ($txt) = shift;
    $txt =~ s/\n$//;
	push(@warnings,$txt);
	prt("$txt\n");
}

sub show_warnings {
	my $wcnt = scalar @warnings;
	if ($wcnt) {
		prt( "\nThere are $wcnt lines of WARNINGS ...\n" );
		foreach my $wn (@warnings) {
			prt("$wn\n");
		}
	} else {
		prt( "There are NO warnings ...\n" );
	}
    prt("\n");
}

# eof - msvc8incs.pl

