Generated: Tue Feb 2 17:54:46 2010 from msvc8incs.pl 2008/11/23 17.2 KB.
#!/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