#!/Perl
# vc8srcs02.pl
# AIM: Source list from MSVC8 project file
# but this version starts with the SOLUTION (.sln) file,
# finds the PROJECT (.vcproj), and does a source compare
# with the relative directories given in there ...
# First try, using XML::Simple, so
use XML::Simple;
# 20061128 - BUT XML::Simple IS NOT SO SIMPLE!!! See vc8scrs03.pl for try WITHOUT
use Data::Dumper; # just for DEBUG, when the parsing goes wrong ...
require "logfile.pl" or die "Missing logfile.pl ...\n"; # my simple log file and some other utility subs
require "amfile01.pl" or die "Missing amfile01.pl ...\n"; # parse AM file ...

# NOTE: Reports - could not find ParserDetails.ini in C:/Perl/site/lib/XML/SAX
# from : http://perl-xml.sourceforge.net/faq/#parserdetails.ini
# Suggestion: run - ppm install http://theoryx5.uwinnipeg.ca/ppms/XML-SAX.ppd
# set a DEFAULT input file name
my $in_file = 'C:\FG\FG0910-8\fgfs\fgfs.sln';
##my $in_file = 'F:\FG0910-4\flightgear\projects\VC8\FlightGear.sln';
##my $in_file = 'F:\FG0910-4\simgear\projects\VC8\simgear.sln';
### features
my $DO_COMPARE = 0;	# add read makefile.am for sources, but this does NOT work
# on projects that do NOT use Makefile.am to control SOURCES
my $in_dir = '';
my $dbg_on1 = 0;
my $dbg_on2 = 0;
my $dbg_on3 = 0;
my $dbg_on4 = 0;
my $dbg_on5 = 0;	# show squirling down
my $dbg_src = 0;	# show each SOURCE, as found
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
open_log($outfile);
my $file = '';
my $ff = '';
my $fl1 = 'Files';
my $fl2 = 'File';
my $fl3 = 'RelativePath';
my $fl4 = 'Filter';
my $cnt = 0;
my @csrc_array = ();
my @hsrc_array = ();
my @osrc_array = ();
my @cdir_array = ();
my @hdir_array = ();
my @odir_array = ();
my @files = ();
my @lines = ();
my @proj_files = ();
my @proj_dirs = ();
my @not_found = ();
my @not_found2 = ();
my $prev_srcs = 0;
my $prev_hdrs = 0;
my $prev_othe = 0;
my $line = '';
my $try3 = 0;
my @am_sources = ();
prt( "$0 ... Hello, World ...\n" );
if (@ARGV) {
	$in_file = shift @ARGV;
}
if ( -f $in_file ) {
	if (is_solution($in_file)) {
		get_xml_projects();
	} elsif (is_vcproj($in_file)) {
		push(@proj_files, $in_file);
	} else {
		prt( "WARNING: Unknown file type [$in_file] ...\n" );
		prt( "Proceeding ASSUMING a project (XML) file ...\n" );
		push(@proj_files, $in_file);
	}
	if (@proj_files) {
		prt("Processing ".scalar @proj_files." file(s) ...\n");
	} else {
		mydie( "ERROR: Have no PROJECT (.vcproj) files to process!\n" );
	}
	foreach $line (@proj_files) {
		get_xml_sources($line);
		$prev_srcs = scalar @csrc_array;
		$prev_hdrs = scalar @hsrc_array;
		$prev_othe = scalar @osrc_array;
	}
	if($prev_srcs == 0) {
		mydie("ERROR: No C/C++ sources found to process ...\n");
	}
	prt("\nGetting folder list from C/C++ source files ...\n");
	foreach my $fl (@csrc_array) {
		my $dir = file_dirname($fl);
		if (!in_dir_array($dir)) {
			prt("Adding folder [$dir] to \$proj_dirs list ...\n") if ($dbg_on3);
			push(@proj_dirs, $dir);
		}
	}

	if ($DO_COMPARE) {
		prt("Got ".scalar @proj_dirs." folders to check ...\n" );
		$prev_srcs = 0;
		$prev_hdrs = 0;
		$prev_othe = 0;
		foreach my $line2 (@proj_dirs) {
			get_dir_sources($line2); # and process any AM file found ...
			$prev_srcs = scalar @cdir_array;
			$prev_hdrs = scalar @hdir_array;
			$prev_othe = scalar @odir_array;
		}

		cmp_c_sources();
		if (@am_sources) {
			prt("Also got ".scalar @am_sources." SOURCE files from AM files ...\n");
			cmp_am_sources();
		}
	}
} else {
	prt( "ERROR: Can not locate [$in_file] or [$in_dir] ... aborting ...\n" );
}

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

##############################################
### program subs
sub in_dir_array {
	my ($d1) = shift;
	foreach my $d2 (@proj_dirs) {
		if ($d1 eq $d2) {
			return 1;
		}
	}
	return 0;
}

# get_xml_projects
# parse the MS solution file, and extract the VCPROJ files
# contined there in ...
sub get_xml_projects {
	my $in_fd = file_dirname($in_file);
	prt( "Loading [$in_file] in directory [$in_fd] ...\n" );
	open FH, "<$in_file" or mydie( "ERROR: Can not open [$in_file] ... aborting ...\n" );
	@lines = <FH>; # slurp the whole file
	close( FH );
	prt( "Got ".scalar @lines." in $in_file ...\n" );
	my $hadver = 0;
	foreach $line (@lines) {
		chomp $line;
		if ($hadver) {
			if ($line =~ /^Project\s*\(/) {
				##prt( "Got project [$line] ...\n" );
				my @arr = split( /\"/, $line );
				foreach my $par (@arr) {
					if (is_vcproj($par)) {
						$ff = $in_fd.$par;
						prt( "Got PROJECT file [$par] " );
						if ( -f $ff) {
							prt( "ok" );
						} else {
							prt( "FAILED" );
						}
						prt("\n");
						push(@proj_files, $ff);
					}
				}
			}
		} else {
			# seeking 'Microsoft Visual Studio Solution File, Format Version 9.00'
			#if ($line =~ /^Microsoft\s+.(\d+\.\d+)/) {
			if ($line =~ /^Microsoft\s+/) {
				if ($line =~ /.(\d+\.\d+)/) {
					my $ver = $1;
					prt( "Got solution file version [$ver] ...\n" );
					$hadver = 1;
				}
			}
		}
	}
}

# get_dir_sources
# Process the relative folders from the project file,
# and collect ALL the files in those folders ...
# An extension would be to parse the makefile.am, if present,
# and check WHAT sources actually SHOULD be included
# Some sources belong to other test executable items, or
# perhaps are just not used unless certain 'switches' are on ...
# And this does NOT include other possible folders, not already
# apparent from the VCPROJ files ...
sub get_dir_sources {
	my ($in) = shift;
	prt( "\nProcessing directory [$in] ...\n" ) if ($dbg_on4);
	if ( !opendir(DIR, $in) ) {
		prt( "ERROR: Unable to open directory [$in] ...\n" );
		return;
	};
	@files = readdir(DIR);
	closedir DIR;
	$cnt = 0;
	foreach $file (@files) {
		if (($file eq '.') || ($file eq '..')) {
			next;
		}
		$cnt++;
		###$ff = $in_dir . '\\' . $file;
		$ff = $in . $file;
		# prt( "$cnt $file ($ff)\n" );
		if (is_c_source($file)) {
			prt( "src $cnt $file ($ff)\n" ) if ($dbg_on2);
			push(@cdir_array,$ff);
		} elsif (is_h_source($file)) {
			prt( "hdr $cnt $file ($ff)\n" ) if ($dbg_on2);
			push(@hdir_array,$ff);
		} else {
			prt( "other $cnt $file ($ff)\n" ) if ($dbg_on2);
			push(@odir_array,$ff);
			if ($file =~ /\.am$/i) {
				prt( "\nProcessing AM file [$ff] ...\n" ) if ($dbg_on2);
				initialize_per_input();
				my @arr = read_am_file($ff);
				foreach my $s (@arr) {
					my $s2 = trim_line($s);
					if (length($s2)) {
						if (is_c_source($s2)) {
							my $ff2 = $in.$s2;
							push(@am_sources, $ff2);
						} elsif (is_h_source($s2)) {
							# quietly FORGET these ... for now ...
						} else {
							prt( "CHECK Discarded [$s2] ...\n" );
						}
					}
				}
				prt( "Done AM file [$ff] ...got ".scalar @arr." sources ...\n" ) if ($dbg_on2);
			}
		}
	}
	my $new_srcs = scalar @cdir_array - $prev_srcs;
	my $new_hdrs = scalar @hdir_array - $prev_hdrs;
	my $new_othe = scalar @odir_array - $prev_othe;
	prt( "Got new $new_srcs C/C++ files, $new_hdrs header files, and others $new_othe\n" ) if ($dbg_on4);
	prt( "Got ".scalar @cdir_array." C/C++ files, ".scalar @hdir_array. " header files" ) if ($dbg_on4);
	if (@odir_array) {
		prt( " and ".scalar @odir_array." other files" ) if ($dbg_on4);
	}
	prt("\n") if ($dbg_on4);
}

# get_xml_source
# process the XML project file (*.vcproj) and
# extract the SOURCE file list
sub get_xml_sources {
	my ($in) = shift;
	my $in_fd = file_dirname($in);
	prt( "Loading [$in] file in directory [$in_fd] ...\n" );
	# create object
	my $xml = new XML::Simple;
	#my $xml = new XML::Simple (KeyAttr=>[]);

	# read XML file
	my $data2 = $xml->XMLin($in);
	# print output
	###prt( Dumper($data2) );
	prt( "Getting array of [$fl1] ...\n" );
	my $dfiles = $data2->{$fl1};
	#my $files = $data->{$fl1}->{$fl2};
	#my $files = $data->{$fl1}->{$fl2}->{$fl3};
	#prt( Dumper($dfiles) );
	my $type = ref($dfiles);
	prt( "Processing for each [$fl2] ...type=$type...\n" );
	$cnt = 0;
	if ((defined $type) && ($type eq 'HASH')) {
		foreach my $e (keys %{$dfiles}) {
			my $dval = $dfiles->{$e};
			$type = ref($dval);
			prt("key = [$e] ...$type\n") if ($dbg_on5);
			if ($type eq 'HASH') {
				foreach my $f (keys %{$dval}) {
					prt( "Hsubkey = $f ...\n" ) if ($dbg_on5);
				}
			} else {
				foreach my $f (@{$dval}) {
					my $ty2 = ref($f);
					prt( "Asubkey = $f ...[$ty2]\n" ) if ($dbg_on5);
					if ($ty2 eq 'HASH') {
						foreach my $g (keys %{$f}) {
							my $ty3 = ref($g);
							my $dval3 = $f->{$g};
							if (ref($dval3) eq 'ARRAY') {
								prt("Subsubkeys = $g [$ty3] ... ARRAY\n" ) if ($dbg_on5);
								foreach my $h (@{$dval3}) {
									my $ty4 = ref($h);
									prt("Subsubsubkeys = $h [$ty4] ...\n" ) if ($dbg_on5);
									if ($ty4 eq 'HASH') {
										foreach my $j (keys %{$h}) {
											my $dval4 = $h->{$j};
											if (ref($dval4) eq 'ARRAY') {
												prt( "subsubsubsubkeys = $j ... ARRAY\n" ) if ($dbg_on5);
											} else {
												if ($j =~ /^RelativePath$/i) {
													$cnt++;
													$ff = $in_fd . $dval4;
													prt( "$cnt $dval4 ($ff)\n" ) if ($dbg_src);
													if (is_c_source($dval4)) {
														push(@csrc_array,$ff);
													} elsif (is_h_source($dval4)) {
														push(@hsrc_array,$ff);
													} else {
														push(@osrc_array,$ff);
													}
												} else {
													prt( "subsubsubsubkeys = $j ... [$dval4]\n" ) if ($dbg_on5);
												}
											}
										}
									}
								}
							} else {
								prt("Subsubkeys = $g [$ty3] ... $dval3\n" ) if ($dbg_on5);
							}
						}
					}
				}
			}
		}
		##close_log($outfile,1);
		##exit(0);
	} else {
		foreach my $e (@{$dfiles->{$fl2}}) {
			$cnt++;
			#prt( Dumper($e) );
			$file = $e->{$fl3};
			$ff = $in_fd . $dfile;
			#prt( $e->{$fl3}."\n" );
			prt( "$cnt $file ($ff)\n" );
			if (is_c_source($dfile)) {
				push(@csrc_array,$ff);
			} elsif (is_h_source($dfile)) {
				push(@hsrc_array,$ff);
			} else {
				push(@osrc_array,$ff);
			}
		}
	}
	if ($cnt == 0) {
		prt( "\nGot ZERO on [$fl1][$fl2] ... try another way ...\n" );
		my @xmlkeys = ();
		###my @srcfls = ();
		###my @hdrfls = ();
		foreach my $key (keys %{$data2}) {
			##prt( "$cnt $key\n" );
			push(@xmlkeys, $key);
		}
		my $cnt1 = 0;
		foreach my $k (@xmlkeys) {
			$cnt1++;
			###prt( "\n$cnt1 $k\n" );
			my $data = $data2->{$k};
			###prt( Dumper($data) );
			if ($k eq 'Version') {
				prt( "File Version = ".$data."\n" );
			} elsif ($k eq 'Files') {
				prt( "Enumerating Files ...\n" );
				my $cnt2 = 0;
				foreach my $k2 (keys %{$data}) {
					$cnt2++;
					my $data3 = $data->{$k2};
					##prt( "$cnt2 $k2 ...\n" );
					my $cnt3 = 0;
					my $hadsrc = 0;
					my $hadhdr = 0;
					my $typ2 = ref($data3);
					if ($typ2 eq 'ARRAY') {
						foreach my $k3 (@{$data3}) {
							$cnt3++;
							###prt( "  $cnt3\n".Dumper($k3) );
							$hadsrc = 0;
							$hadhdr = 0;
							foreach my $k4 (keys %{$k3}) {
								###prt( "   $k4\n" );
								if ($k4 =~ /Name/i) {
									my $vnm = $k3->{$k4};
									###prt( "Name is [$vnm]\n" );
									if ($vnm =~ /^Source\s+Files/i) {
										$hadsrc = 1;
									} elsif ($vnm =~ /^Header\s+Files/i) {
										$hadhdr = 1;
									}
								}
							}
							if ($hadsrc || $hadhdr) {
								if ($hadsrc) {
									prt( "Found SOURCE FILES ...\n" );
								} else {
									prt( "Found HEADER FILES ...\n" );
								}
								my $sh = $k3->{'File'};
								###prt( Dumper($sh) );
								my $typ3 = ref($sh);
								if ($typ3 eq 'ARRAY') {
									foreach my $k5 (@{$sh}) {
										###prt( "$k5\n" );
										foreach my $k6 (keys %{$k5}) {
											my $src = $k5->{$k6};
											$ff = $in_fd . $src;
											###prt( "$k6=$src\n" );
											if (is_c_source($src)) {
												prt( "src $k6=$src\n" ) if ($dbg_on1);
												push(@csrc_array,$ff);
											} elsif (is_h_source($src)) {
												prt( "hdr $k6=$src\n" ) if ($dbg_on1);
												push(@hsrc_array,$ff);
											} else {
												prt( "other $k6=$src\n" ) if ($dbg_on1);
												push(@osrc_array,$ff);
											}
											##if ($hadsrc) {
											##	push(@srcfls, $src);
											##} else {
											##	push(@hdrfls, $src);
											##}
										}
									}
								} else {
									prt( "\nFAILED: sh is NOT ARRAY, it is [$typ3] ...\n\n" );
								}
							}
						}
					} else {
						prt( "\nFAILED: data3 is NOT ARRAY, it is [$typ2] ...\n\n" );
					}
				}
			}
		}
	} # if $cnt is ZERO
	my $new_srcs = scalar @csrc_array - $prev_srcs;
	my $new_hdrs = scalar @hsrc_array - $prev_hdrs;
	my $new_othe = scalar @osrc_array - $prev_othe;
	prt( "Got new $new_srcs C/C++ files, $new_hdrs header files, and others $new_othe\n" );
	prt( "Got ".scalar @csrc_array." C/C++ files, ".scalar @hsrc_array. " header files" );
	if (@osrc_array) {
		prt( " and ".scalar @osrc_array." files" );
	}
	prt("\n");
}

sub cmp_c_sources {
	my ($f1, $f2);
	my $fnd = 0;
	my $ft = '';
	prt( "\nComparing C/C++ sources ...\n" );
	prt( "\nFinding ".scalar @csrc_array." from \@csrc_array, in ".scalar @cdir_array." of \@cdir_array...\n");
	$cnt = 0;
	foreach $f1 (@csrc_array) {
		$fnd = 0;
		foreach $f2 (@cdir_array) {
			if ( lc(file_name($f1)) eq lc(file_name($f2)) ) {
				$fnd = 1;
				last;
			}
		}
		if ($fnd == 0) {
			$ft = file_name($f1);
			prt( "NOT FOUND $ft [$f1]\n" );
			push(@not_found, $f1);
			$cnt++;
		}
	}
	if ($cnt) {
		prt( "MISSED $cnt - It appears these need to be DELETED from the PROJECT file ...\n" );
	}

	prt( "\nFinding ".scalar @cdir_array." from \@cdir_array, in ".scalar @csrc_array." of \@csrc_array...\n");
	$cnt = 0;
	foreach $f1 (@cdir_array) {
		$fnd = 0;
		foreach $f2 (@csrc_array) {
			if ( lc(file_name($f1)) eq lc(file_name($f2)) ) {
				$fnd = 1;
				last;
			}
		}
		if ($fnd == 0) {
			$ft = file_name($f1);
			prt( "NOT FOUND $ft [$f1]\n" );
			push(@not_found, $f1);
			$cnt++;
		}
	}
	if ($cnt) {
		prt( "MISSED $cnt - It appears these need to be ADDED to the PROJECT file ...\n" );
	}

	if (@not_found) {
		prt( "\nCHECK this list of ".scalar @not_found." files carefully ...\n" );
	}
}

sub cmp_am_sources {
	my ($f1, $f2);
	my $fnd = 0;
	my $ft = '';
	prt( "\nComparing C/C++ sources from AM files ...\n" );
	prt( "\nFinding ".scalar @csrc_array." from \@csrc_array, in ".scalar @am_sources." of \@am_sources...\n");
	$cnt = 0;
	foreach $f1 (@csrc_array) {
		$fnd = 0;
		foreach $f2 (@am_sources) {
			if ( lc(file_name($f1)) eq lc(file_name($f2)) ) {
				$fnd = 1;
				last;
			}
		}
		if ($fnd == 0) {
			$ft = file_name($f1);
			prt( "NOT FOUND $ft [$f1] DELETE?\n" );
			push(@not_found2, $f1);
			$cnt++;
		}
	}
	if ($cnt) {
		prt( "MISSED $cnt - It appears these need to be DELETED from the PROJECT file ...\n" );
	}

	prt( "\nFinding ".scalar @am_sources." from \@am_sources, in ".scalar @csrc_array." of \@csrc_array...\n");
	$cnt = 0;
	foreach $f1 (@am_sources) {
		$fnd = 0;
		foreach $f2 (@csrc_array) {
			if ( lc(file_name($f1)) eq lc(file_name($f2)) ) {
				$fnd = 1;
				last;
			}
		}
		if ($fnd == 0) {
			$ft = file_name($f1);
			prt( "NOT FOUND $ft [$f1] ADD?\n" );
			push(@not_found2, $f1);
			$cnt++;
		}
	}
	if ($cnt) {
		prt( "MISSED $cnt - It appears these need to be ADDED to the PROJECT file ...\n" );
	}

	if (@not_found2) {
		prt( "\nCHECK this list of ".scalar @not_found2." files carefully ...\n" );
	}
}

### utitlity subs
sub is_c_source {
	my $f = shift;
	if ( ($f =~ /\.c$/i) || ($f =~ /\.cpp$/i) || ($f =~ /\.cxx$/i) ) {
		return 1;
	}
	##if (!is_h_source($f)) {
	##	prt( "Item [$f] IS NOT C/C++ SOURCE!\n" );
	##}
	return 0;
}

sub is_h_source {
	my $f = shift;
	if ( ($f =~ /\.h$/i) || ($f =~ /\.hpp$/i) || ($f =~ /\.hxx$/i) ) {
		return 1;
	}
	##if (!is_c_source($f)) {
	##	prt( "Item [$f] IS NOT C/C++ SOURCE!\n" );
	##}
	return 0;
}

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

# eof - vc8srcs01.pl

