#!/perl -w
# NAME: cmpvcprojs.pl
# AIM: To compare two VCPROJ files, and list -
# (a) the different source, either added or deleted, and
# (b) the differenct libraries, for both Debug and Release ...
# This implementation was based on the code from vcprojlist.pl, and sln2dsw.pl
# If given SOLUTION file (*.SLN), then each prject contained, will be compared.
# 07/03/2008 - geoff mclane - http://geoffair.net/mperl/samples
use strict;
use warnings;
use File::Basename;
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
require 'relative.pl' or die "Unable to load relative.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);
prt( "$0 ... Hello, World ... at ". scalar localtime(time())."\n" );

my $in_file1 = 'C:\DTEMP\temp\Win32\libtar.vcproj';
my $in_file2 = 'C:\Projects\tar\Win32\libtar.vcproj';
#my $in_file1 = 'C:\FG\18\fgfs\fgfs.sln';
#my $in_file2 = 'C:\FG\19\fgfs\fgfs.sln';
my $v8_cfgexp = '<Configuration\\s+.*Name=\\"(\\S+)\\"\\s';

my %sln_projects1 = ();	# projects FOUND in SLN file - key=name, data=vcproj file
my %sln_projpath1 = ();	# and the RELATIVE path of the project, IF ANY ...
my %sln_projects2 = ();	# projects FOUND in SLN file - key=name, data=vcproj file
my %sln_projpath2 = ();	# and the RELATIVE path of the project, IF ANY ...

# degug
my $dbg_sl1 = 0;
my $dbg1 = 0;	# show all the files, and their directory
my $dbg2 = 0;
my $dbg2a = 0;
my $dgb3 = 0;
my $dbg_src6 = 0;
my $dbg_src7 = 0;
my $dbg_src12 = 0;
my $dbg_src12a = 0;
my $dbg_src13 = 0;

my @warnings = ();
my @deleted = ();
my @added = ();

# work items
my %sln_projects = ();	# projects FOUND in SLN file - key=name, data=vcproj file
my %sln_projpath = ();	# and the RELATIVE path of the project, IF ANY ...
my ($xnm,$xdir,$xext, $prj1, $val1, $val2);
my @srclist = ();
my %v8_depend = ();
my $msg = '';

# DO FILE ONE
%sln_projects = ();	# clear entries
%sln_projpath = ();
if (is_solution($in_file1)) {
	process_SLN( $in_file1 );
} elsif (is_vcproj($in_file1)) {
	($xnm,$xdir,$xext) = fileparse( $in_file1, qr/\.[^.]*/ );
	$sln_projects{$xnm} = $in_file1;
	$sln_projpath{$xnm} = $xdir;
} else {
	mydie("ERROR: $in_file1 is NOT solution (.SLN) nor project (.vcproj)!!!\n");
}
%sln_projects1 = %sln_projects;	# projects FOUND in SLN file - key=name, data=vcproj file
%sln_projpath1 = %sln_projpath;	# and the RELATIVE path of the project, IF ANY ...

# DO FILE TWO
%sln_projects = ();	# clear entries
%sln_projpath = ();
process_SLN( $in_file2 );
if (is_solution($in_file2)) {
	process_SLN( $in_file2 );
} elsif (is_vcproj($in_file2)) {
	($xnm,$xdir,$xext) = fileparse( $in_file2, qr/\.[^.]*/ );
	$sln_projects{$xnm} = $in_file2;
	$sln_projpath{$xnm} = $xdir;
} else {
	mydie("ERROR: $in_file1 is NOT solution (.SLN) nor project (.vcproj)!!!\n");
}
%sln_projects2 = %sln_projects;	# projects FOUND in SLN file - key=name, data=vcproj file
%sln_projpath2 = %sln_projpath;	# and the RELATIVE path of the project, IF ANY ...
# DONE BOTH INPUT FILES
if ($dbg2) {
	foreach $prj1 (keys %sln_projects1) {
		$val1 = $sln_projects1{$prj1};
		if (defined $sln_projects2{$prj1}) {
			$val2 = $sln_projects2{$prj1};
		} else {
			$val2 = "Does NOT exist";
		}
		if (uc($val1) eq uc($val2)) {
			$val2 = "*** THE SAME FILE ***";
		}
		prt("proj=$prj1 - cmp [$val1] with [$val2]\n");
	}
	foreach $prj1 (keys %sln_projects2) {
		$val2 = $sln_projects2{$prj1};
		if (defined $sln_projects1{$prj1}) {
			$val1 = $sln_projects1{$prj1};
		} else {
			$val1 = "Does NOT exist";
			prt("proj=$prj1 - cmp [$val1] with [$val2]\n");
		}
	}
}

my ($nm,$dir, $ext);
foreach $prj1 (keys %sln_projects1) {
	$val1 = $sln_projects1{$prj1};
	if (defined $sln_projects2{$prj1}) {
		$val2 = $sln_projects2{$prj1};
		@srclist = ();
		%v8_depend = ();
		$nm = $prj1;
		##$dir = $sln_projpath1{$prj1};
		my @xlines1 = load_xml_lines( $val1 );
		process_xml_lines( $prj1, $dir, @xlines1 );
		my @srclist1 = @srclist;
		my %v8_depend1 = %v8_depend;
		@srclist = ();
		%v8_depend = ();
		##$dir = $sln_projpath2{$prj1};
		my @xlines2 = load_xml_lines( $val2 );
		process_xml_lines( $prj1, $dir, @xlines2 );
		my @srclist2 = @srclist;
		my %v8_depend2 = %v8_depend;
		# NOW TO COMPARE SOURCE LIST 1 and 2
		####################################
		my $s1cnt = scalar @srclist1;
		my $s2cnt = scalar @srclist2;
		###                  0     1    2    3     4
		###	push( @srclist, [$src, $ff, $rp, $dir, 0] );
		my ($i, $j, $src1, $src2, $fnd1, $fnd2, $miss1, $miss2);
		for ($i = 0; $i < $s1cnt; $i++) {
			$src1 = $srclist1[$i][0];
			$fnd1 = 0;
			for ($j = 0; $j < $s2cnt; $j++) {
				$src2 = $srclist2[$j][0];
				if (uc($src1) eq uc($src2)) {
					$srclist1[$i][4] = $j + 1;
					$srclist2[$j][4] = $i + 1;
					$fnd1 = 1;
					last;
				}
			}
		}
		$miss1 = 0;
		$miss2 = 0;
		for ($i = 0; $i < $s1cnt; $i++) {
			$src1 = $srclist1[$i][0];
			if ($srclist1[$i][4] == 0) {
				$msg = "$prj1 - $src1 NOT FOUND IN 2 ... DELETED";
				push(@deleted, $msg);
				prt( "$msg\n" );
				$miss1++;
			}
		}
		$miss2 = 0;
		for ($j = 0; $j < $s2cnt; $j++) {
			$src2 = $srclist2[$j][0];
			if ($srclist2[$j][4] == 0) {
				$msg = "$prj1 - $src2 NOT FOUND IN 1 ... ADDED";
				prt( "$msg\n" );
				push(@added, $msg);
				$miss2++;
			}
		}
		if (($miss1 == 0)&&($miss2 == 0)) {
			prt( "$prj1 - Appears the SAME ...\n" );
		} else {
			$msg = "$prj1 - Missed 1 = $miss1, Missed 2 = $miss2";
			prt( "$msg ...\n" );
		}
		############################################
		####### NOW COMPARE THE LIBRARY LISTS ######
		# %v8_depend1 and %v8_depend2 - Key is CONFIG (Release or Debug)
		# and value is the LIBRARY LIST
		foreach my $ky (keys %v8_depend1) {
			my $val1 = $v8_depend1{$ky};
			prt( "For configuration [$ky] ... library list ...\n" );
			my @liblist1 = split(/\s/,$val1);
			foreach my $itm  (sort @liblist1) {
				prt( "$itm\n" );
			}
			if (defined $v8_depend2{$ky}) {
				my $val2 = $v8_depend2{$ky};
				my @liblist2 = split(/\s/,$val2);
				$s1cnt = scalar @liblist1;
				$s2cnt = scalar @liblist2;
				for ($i = 0; $i < $s1cnt; $i++) {
					$val1 = $liblist1[$i];
					for ($j = 0; $j < $s2cnt; $j++) {
						$val2 = $liblist2[$j];
						if (uc($val1) eq uc($val2)) {
							$liblist1[$i] = '';
							$liblist2[$j] = '';
							last;
						}
					}
				}
				for ($i = 0; $i < $s1cnt; $i++) {
					$val1 = $liblist1[$i];
					if (length($val1)) {
						$msg = "$prj1 - $ky=$val1 NOT FOUND IN 2 ... DELETED LIBRARY";
						push(@deleted, $msg);
						prt( "$msg\n" );
					}
				}
				for ($j = 0; $j < $s2cnt; $j++) {
					$val2 = $liblist2[$j];
					if (length($val2)) {
						$msg = "$prj1 - $ky=$val2 NOT FOUND IN 1 ... ADDED LIBRARY";
						push(@added, $msg);
						prt( "$msg\n" );
					}
				}
			} else {
				prtw( "$prj1 - KEY $ky NOT FOUND IN v8_depend2!" );
			}
		}
		############################################
	} else {
		$val2 = "Does NOT exist";
		prt("proj=$prj1 - cmp [$val1] with [$val2]\n");
	}
}

prt( "\nIn comparing 1[$in_file1], with 2[$in_file2] ...\n" );
if (@deleted) {
	prt( "Appears ".scalar @deleted." DELETED items ...\n" );
	foreach $msg (@deleted) {
		prt( "$msg\n" );
	}
}
if (@added) {
	prt( "Appears ".scalar @added." ADDED items ...\n" );
	foreach $msg (@added) {
		prt( "$msg\n" );
	}
}
if (!@deleted && !@added) {
    prt( "Appears they have the SAME source list ...\n" );
}

show_warnings();
prt("\n");
close_log($outfile,1);
exit(0);

#############################################################
### sub only below

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;
}

# 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 process_xml_lines {
	my ($aproj, $adir, @xlines) = @_;
	my $xlncnt = scalar @xlines;
	prt( "$aproj ($adir) ... processing $xlncnt XML lines ...\n" );
	# looking for '<File RelativePath="..\..\src\osg\ApplicationUsage.cpp" >'
	my $conf = '';
	my $adddeps = '';
	foreach my $fline (@xlines) {
		if ($fline =~ /$v8_cfgexp/ ) {
			##if ($fline =~ /<Configuration\s+.*Name=\"(\S+)\"\s/ ) {
			$conf = $1;
			prt( "Got configuration $conf\n" ) if ($dbg_src6);
		} elsif ($fline =~ /^<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] $dir\n" ) if ($dbg1);
			$src =~ s/^\.[\/\\]// if (length($src) > 2);	# remove any '.\' from the file name
			push( @srclist, [$src, $ff, $rp, $dir, 0] );
		} elsif ($fline =~ /<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 ...[$fline]\n" ) if ($dbg_src7);
					my @attribs = space_split($fline);
					my %atthash = array_2_hash_on_equals(@attribs);
					if ($dbg_src12a) {	# DEBUG ONLY
						prt( "Split of attribs [$fline] ...\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 is_vcproj {
	my $fil = shift;
	if ($fil =~ /\.vcproj$/i) {
		return 1;
	}
	return 0;
}

sub is_solution {
	my $fil = shift;
	if ($fil =~ /\.sln$/i) {
		return 1;
	}
	return 0;
}


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

sub fix_rel_path {
	my ($path) = shift;
	$path = path_u2d($path);	# ENSURE DOS PATH SEPARATOR (in relative.pl)
	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 {
				prtw( "WARNING: Got relative .. without previous!!! path=$path\n" );
			}
		} else {
			push(@na,$p);
		}
	}
	foreach my $pt (@na) {
		$npath .= "\\" if length($npath);
		$npath .= $pt;
	}
	return $npath;
}


sub process_SLN {
	my ($fil) = shift;
	my ($cnt, $line, $vers, @arr, $mver, $par, $ff, $itmnum);
	my ($projname, $projfile, $projff, $gotproj, $relpath);
	my ($tnm,$tpth);
	open IF, "<$fil" or mydie( "ERROR: Unable to open $fil ... $! ...\n" );
	my @lines = <IF>;
	close IF;
	$cnt = scalar @lines;
	my ($name,$sln_path) = fileparse($fil);
	prt( "\nProcessing $cnt lines ... n=[$name] p=[$sln_path] ...\n" );
	$projname = '';
	$projfile = '';
	$projff = '';
	$gotproj = 0;
	foreach $line (@lines) {
		if ($line =~ /.+Format\s+Version\s+(\d+\.\d+)$/i) {
			$vers = $1;	# get n.nn version
			@arr = split(/\./,$vers);
			$mver = $arr[0];
			prt( "Is MSVC Version $mver ...\n" );
		} elsif ($line =~ /^Project\s*\(/) {
			###prt( "Got project [$line] ...\n" );
			@arr = split( '=', $line );
			$cnt = scalar @arr;
			if ($cnt == 2) {
				$par = $arr[1];
				@arr = split(',', $par);
				$cnt = scalar @arr;
				if ($cnt == 3) {
					$projname = strip_quotes(trim_all($arr[0]));
					$projfile = strip_quotes(trim_all($arr[1]));
					$projff = fix_rel_path($sln_path.$projfile);
					if ((length($projname)) && (is_vcproj($projfile)) && (-f $projff)) {
						$gotproj = 1;
						($tnm,$tpth) = fileparse($projff);
						$relpath = get_rel_dos_path($tpth, $sln_path);
						prt( "Got PROJECT name=$projname, file=$projff, rel=[$relpath].\n" ) if ($dbg_sl1);
						###push(@proj_files, $projff);
						if (defined $sln_projects{$projname} &&
							(uc($projff) ne uc($sln_projects{$projname}) )) {
							prt( "Attempting to add [$projname] ... ff=[$projff]\n" );
							prt( "But found ... ff=[".$sln_projects{$projname}."] already!!!\n" );
							mydie( "A PROBLEM: Already GOT this project name $projname!!!\n" );
						} else {
							$sln_projects{$projname} = $projff;
							$sln_projpath{$projname} = $relpath; # can be BLANK, or say 'BvMath/'
						}
					}
				}
			}
			if (!$gotproj) {
				@arr = split( /\"/, $line );
				$itmnum = 0;
				foreach $par (@arr) {
					$itmnum++;
					###prt( "$itmnum [$par]\n" );
					if (is_vcproj($par)) {
						$ff = $sln_path.$par;
						prt( "Got PROJECT file [$par] " );
						if ( -f $ff) {
							prt( "ok" );
							###push(@proj_files, $ff);
							my ($nm,$pt,$ex) = fileparse( $ff, qr/\.[^.]*/ );
							$projname = $nm;
							($tnm,$tpth) = fileparse($ff);
							$relpath = get_rel_dos_path($tpth, $sln_path);
							if (defined $sln_projects{$projname}) {
								prt( "Attempting to add [$projname] ... ff=[$ff]\n" );
								prt( "But found ... ff=[".$sln_projects{$projname}."] already!!!\n" );
								mydie( "A PROBLEM: Already GOT this project name $projname!!!\n" );
							} else {
								$sln_projects{$projname} = $ff;
								$sln_projpath{$projname} = $relpath; # can be BLANK, or say 'BvMath/'
							}
						} else {
							prt( "FAILED" );
						}
						prt("\n");
					}
				}
			}
		}
	}
	###prt( "Done $fil ... got ".scalar @proj_files." project files ...\n" );
	prt( "Done $fil ... got ".scalar keys(%sln_projects)." project files ...\n" );
}

sub load_xml_lines {
	my ($inf) = shift;
	my @xlines = ();
	my ($line);
	if ( !open INF, "<$inf" ) {
		prtw( "WARNING: Failed to open [$inf] ... $! ... \n" );
		return @xlines;
	}
	my @lines = <INF>;
	close INF;
	my $lncnt = scalar @lines;
	($nm,$dir,$ext) = fileparse( $inf, qr/\.[^.]*/ );
	prt( "Processing $lncnt lines from [$nm$ext] path=[$dir]...\n" ) if ($dbg2 || $dbg2a);
	my $xml = '';
	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;
	prt("Returning $xlncnt lines ...\n" ) if ($dbg2);
	return @xlines;
}


sub prtw {
	my ($wmsg) = shift;
	prt($wmsg);
	push(@warnings,$wmsg);
}

sub show_warnings {
	if (@warnings) {
		prt( "WARNING: Got ".scalar @warnings." warnings messages ...\n" );
		foreach my $wm (@warnings) {
			prt($wm);
		}
	} else {
		prt( "No warning or error messages ...\n" );
	}
}

# eof - cmpvcprojs.pl
