#!/perl -w
# NAME: vcprojlist.pl
# AIM: Parse a vcproj file, and list the sources is contains.
# 07/03/2008 - add show of LIBRARIES used for each configuration
# 15/05/2007 - geoff mclane - http://geoffmclane.com/mperl/index.htm
use strict;
use warnings;
use File::Basename;
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
if ($0 =~ /\w{1}:\\.*/) {
	my @tmpsp = split(/\\/,$0);
	$outfile = 'temp.'.($tmpsp[-1]).'.txt';
}
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
my $def_input =  'C:\FG\19\FlightGear\FlightGear.vcproj';
#my $def_input =  'C:\FG\15\OpenSceneGraph\VisualStudio\osg\osg.vcproj';
my $in_file = $def_input;

my $showsrcs = 1;	## list sources at end
my $showlibs = 1;	## list libraries used, at end

my $dbg1 = 0;	# show as found ...
my $dbg_src6 = 0;	# show "Got configuration $conf ...
my $dbg_src7 = 0;	# show "Is linker tool ...[$fline]\n"
my $dbg_src12 = 0;	# DEBUG ONLY
my $dbg_src12a = 0;	# DEBUG ONLY
my $dbg_src13 = 0;

my $v8_cfgexp = '<Configuration\\s+.*Name=\\"(\\S+)\\"\\s';
my %v8_depend = ();	# linker addtional dependencies, by configuration

my @srclist = ();
my ($line, $i);
my $adddeps = '';

if ( !open INF, "<$in_file" ) {
	mydie( "ERROR: Failed to open [$in_file] ... $! ... \n" );
}
my @lines = <INF>;
close INF;
my $lncnt = scalar @lines;
my ($nm,$dir,$ext) = fileparse( $in_file, qr/\.[^.]*/ );
prt( "Processing $lncnt lines from [$nm$ext] path=[$dir]...\n" );

my $xml = '';
my @xlines = ();
my $inx = 0;
foreach $line (@lines) {
	$line = trim_all($line);
	my $len = length($line);
	$xml .= ' ' if ($len && length($xml));
	for (my $i = 0; $i < $len; $i++) {
		my $ch = substr($line,$i,1);
		if ($inx) {
			if ($ch eq '>') {
				$xml .= $ch;
				push(@xlines, trim_all($xml));
				$inx = 0;
				$xml = '';
				$ch = '';
			}
		} else {
			if ($ch eq '<') {
				if (length($xml)) {
					push(@xlines, trim_all($xml));
				}
				$xml = '';
				$inx = 1;
			}
		}
		$xml .= $ch;
	}
}
$xml = trim_all($xml);
push(@xlines, $xml) if (length($xml));
my $xlncnt = scalar @xlines;
process_xml_lines();
###my $xline = join("\n", @xlines);
###write2file( $xline, "temp1.xml" );
my $scnt = scalar @srclist;
prt( "Got $scnt sources ... relative to [$dir] ...\n" );
if ($showsrcs) {
	for ($i = 0; $i < $scnt; $i++) {
		my $src = $srclist[$i];
		if ( is_cpp_src($src) ) {
			prt( "$src\n" );
		}
	}
}

if ($showlibs) {
	foreach my $ky (keys %v8_depend) {
		my $val = $v8_depend{$ky};
		prt( "For configuration [$ky] ... library list ...\n" );
		my @liblist = split(/\s/,$val);
		foreach my $itm  (sort @liblist) {
			prt( "$itm\n" );
		}
	}
}


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

sub process_xml_lines {
	prt( "Processing $xlncnt XML lines ...\n" );
	# looking for '<File RelativePath="..\..\src\osg\ApplicationUsage.cpp" >'
	my $conf = '';
	foreach $line (@xlines) {
		my $fline = $line;
		if ($fline =~ /$v8_cfgexp/ ) {
			##if ($fline =~ /<Configuration\s+.*Name=\"(\S+)\"\s/ ) {
			$conf = $1;
			prt( "Got configuration $conf\n" ) if ($dbg_src6);
		} elsif ($line =~ /^<File\s+RelativePath=(.*)>/) {
			my $src = $1;
			$src =~ s/"//g;
			while ($src =~ /\s$/) {
				$src = substr($src,0, length($src) - 1); # remove all TRAILING space
			}
			$src = unix_2_dos($src);
			my $ff = $dir;
			if (substr($src,0,1) eq "\\") {
				$src = substr($src,1);
			}
			$ff .= $src;
			$ff = fix_rel_path($ff);
			my $rp = get_rel_path( $dir, $ff );
			prt( "$ff ($src) [$rp]\n" ) if ($dbg1);
			##push( @srclist, [$rp, $ff, $dir, $src] );
			$src =~ s/^\.[\/\\]// if (length($src) > 2);	# remove any '.\' from the file name
			push( @srclist, $src );
		} elsif ($line =~ /<Tool\s+(.*)$/ ) {
			my $pline = $1;
			#prt( "Got Tool $pline\n" ) if ($dbg_src7);
			if ($pline =~ /\s*Name=\"*(\w+)\"*/) {
				my $tname = $1;
				###prt( "$tname\n" );
				if ($tname eq 'VCLinkerTool') {
					# <Tool
					# Name="VCLinkerTool"
					# AdditionalDependencies="comctl32.lib Msimg32.lib Winmm.lib"
					# LinkIncremental="1"
					# GenerateDebugInformation="true"
					# SubSystem="2"
					# OptimizeReferences="2"
					# EnableCOMDATFolding="2"
					# TargetMachine="1"
					# />
					prt( "Is linker tool ...[$line]\n" ) if ($dbg_src7);
					my @attribs = space_split($line);
					my %atthash = array_2_hash_on_equals(@attribs);
					if ($dbg_src12a) {	# DEBUG ONLY
						prt( "Split of attribs [$line] ...\n" );
						foreach $adddeps (@attribs) {
							prt( " $adddeps\n" );
						}
						prt( "Show of HASH ...\n" );
						foreach $adddeps (keys %atthash) {
							prt( " $adddeps = ".$atthash{$adddeps}."\n" );
						}
					}
					if (defined $atthash{'AdditionalDependencies'} ) {
						$adddeps = strip_quotes(trim_all($atthash{'AdditionalDependencies'}));
						prt( "Setting ADDS: $conf [$adddeps]\n" ) if ($dbg_src12);
						$v8_depend{$conf} = $adddeps;
					}
				}
			}
		}
	}
}

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

# split_space - space_split - like split(/\s/,$txt), but honour double inverted commas
sub space_split {
	my ($txt) = shift;
	my $len = length($txt);
	my ($k, $ch, $tag, $incomm);
	my @arr = ();
	$tag = '';
	$incomm = 0;
	for ($k = 0; $k < $len; $k++) {
		$ch = substr($txt,$k,1);
		if ($incomm) {
			$incomm = 0 if ($ch eq '"');
			$tag .= $ch;
		} elsif ($ch =~ /\s/) {
			push(@arr, $tag) if (length($tag));
			$tag = '';
		} else {
			$tag .= $ch;
			$incomm = 1 if ($ch eq '"');
		}
	}
	push(@arr, $tag) if (length($tag));
	if ($dbg_src13) {
		prt( "space_split (".scalar @arr.") of [$txt]\n" );
		foreach $tag (@arr) {
			prt( " $tag\n" );
		}
	}
	return @arr;
}

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}) {
			prt( "WARNING: Duplicate KEY: $key ...\n" );
			$hash{$key} .= "@".$val;
		} else {
			$hash{$key} = $val;
		}
	}
	return %hash;
}



sub is_cpp_src {
	my ($fil) = shift;
	my ($n, $d, $e) = fileparse( $fil, qr/\.[^.]*/ );
	if (lc($e) eq '.cpp') {
		return 1;
	} elsif (lc($e) eq '.c') {
		return 2;
	} elsif (lc($e) eq '.cxx') {
		return 3;
	}
	return 0;
}

sub unix_2_dos {
	my ($f) = shift;
	$f =~ s/\//\\/g;
	return $f;
}

sub get_rel_path {
	my ($path, $src) = @_;
	my @a1 = split(/\\/, $path);
	my @a2 = split(/\\/, $src);
	while ( @a1 && @a2 && ($a1[0] eq $a2[0])) {
		shift @a1;
		shift @a2;
	}
	my $np = join("\\", @a2);
	while (@a1) {
		$np = "..\\".$np;
		pop @a1;
	}
	return $np;
}


sub fix_rel_path {
	my ($path) = shift;
	my @a = split(/\\/, $path);
	my $npath = '';
	my $max = scalar @a;
	my @na = ();
	for (my $i = 0; $i < $max; $i++) {
		my $p = $a[$i];
		if ($p eq '.') {
			# ignore this
		} elsif ($p eq '..') {
			if (@na) {
				pop @na;	# discard previous
			} else {
				prt( "WARNING: Got relative .. without previous!!!\n" );
			}
		} else {
			push(@na,$p);
		}
	}
	foreach my $pt (@na) {
		$npath .= "\\" if length($npath);
		$npath .= $pt;
	}
	return $npath;
}

# eof
