#!/perl -w
# NAME: slnlist.pl
# AIM: Given a MSVC8 SLN file, show the LIST of VCPROJ files it references
# 04/09/2007 - add output of SOURCE files from vcproj files
# 26/04/2007 - geoff mclane - http://geoffmclane.com/mperl/samples/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 $show_rel = 1;
my $fix_rela = 1;
my $show_srcs = 1;	# also OUTPUT the SOURCE files in the project files
my $recursive = 1;

my $dbg_on = 1;	# to run without a command line
my $base_dir = "C:\\FG\\FGCOM\\iaxclient\\";
my $def_input = $base_dir."contrib\\win\\vs2005\\iaxclient.sln";
##my $base_dir = "C:\\FG\\FGCOM\\xmlrpc-c\\";
##my $def_input = $base_dir."Windows\\xmlrpc.sln"; # adjust this to the file you want parsed
###my $base_dir = "C:\\FG\\14\\";
###my $def_input = $base_dir."fgfs\\fgfs.sln"; # adjust this to the file you want parsed
my $in_file = '';
my @file_list = ();
my $pcnt = 0;
my $line = '';
my ($fil_nm,$fil_dir,$fil_ext);
my @warnings = ();
my $wmsg = '';
my $cnt = 0;
my $srccnt = 0;
my @srcsc = ();	# list FROM vcproj files
my @dir_list = ();	# list from DIRECTORY search
my $dir_cnt = 0;
# debug items
my $dbg1 = 0;	# show missing as found ...
my $dbg3 = 0;
my @missing = ();

if ($dbg_on) {
	$in_file = $def_input;
}

if ((length($in_file) == 0) || !( -f $in_file )) {
	if (length($in_file)) {
		mydie( "ERROR: Can NOT locate [$in_file] ... $! ...\n" );
	} else {
		mydie( "ERROR: Must give a SLN input file ...\n" );
	}
}
($fil_nm,$fil_dir,$fil_ext) = fileparse( $in_file, qr/\.[^.]*/ );
if (lc($fil_ext) eq '.sln') {
	# push(@projs, [ $arr[0], $arr[1] ]);
	@file_list = process_sln( $in_file );
} else {
	mydie( "ERROR: Not a SOLUTION (.sln) file [$in_file] ...\n" );
}
$cnt = scalar @file_list;
prt( "Got $cnt files from $in_file ...\n" );
my $rp = substr($in_file, length($base_dir));
prt( "Begin List - first solution name, then VCPROJ files ...\n" );
prt( "$rp\n" );
###	push(@projs, [ $arr[0], $arr[1] ]);
for (my $i = 0; $i < $cnt; $i++) {
	$line = $file_list[$i][1];
	$line = fix_rel($fil_dir.$line);
	$rp = substr($line, length($base_dir));
	if ($show_rel) {
		prt( "$rp\n" );
	} else {
		prt( "$line\n" );
	}
}
prt( "End List of first solution name, then VCPROJ files ...\n" );

if ($show_srcs) {
	for (my $i = 0; $i < $cnt; $i++) {
		$line = $file_list[$i][1];
		$line = fix_rel($fil_dir.$line);
		$rp = substr($line, length($base_dir));
		if ($i == 0) {
			prt( "The SOLUTION FILE: " );
			if ($show_rel) {
				prt( "$rp\n" );
			} else {
				prt( "$line\n" );
			}
		} else {
			if (open(INF, "<$line")) {
				my @lns = <INF>;
				close INF;
				process_vcproj_xml_lines($line, @lns);
			} else {
				prt( "WARNING: FAILED TO OPEN [$line]! ... $! ...\n" );
			}
		}
	}
}

$dir_cnt = process_directory( $base_dir, 0 );

if ($srccnt) {
	my $ccnt = scalar @srcsc;
	prt( "Found $srccnt source files, $ccnt C/C++ sources, $dir_cnt from search ...\n" );
	# compare push(@srcsc, $asrc); from vcproj, and
	# push(@dir_list, $ff); from directory search
	for (my $i = 0; $i < $dir_cnt; $i++) {
		my $fil1 = $dir_list[$i];
		my $fnd = 0;
		for (my $j = 0; $j < $ccnt; $j++) {
			my $fil2 = $srcsc[$j];
			if ($fil1 eq $fil2) {
				$fnd = 1;
				last;
			}
		}
		if (!$fnd) {
			prt( "$fil1 NOT IN VCPROJ files???\n" );
		}
	}

}

if (@missing) {
	my $mcnt = scalar @missing;
	prt( "Got $mcnt MISSING, as follows ...\n" );
	my $cfil = '';
	my ($fil, $mis, $i);
	for ($i = 0; $i < $mcnt; $i++) {
		$fil = $missing[$i][0];
		$mis = $missing[$i][1];
		if ($fil ne $cfil) {
			prt( "Missing from $fil ...\n" );
			$cfil = $fil;
		}
		prt( "$mis - MISSING\n" ); 
	}
}

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

sub process_vcproj_xml_lines {
	my ($fil, @lines) = @_;
	my $max = scalar @lines;
	my $rp = substr($fil, length($base_dir));
	my ($nm,$dir) = fileparse($fil);
	prt( "Got $max lines from $rp to process ...\n" );
	my $fline = '';
	my $fcnt = 0;
	for (my $i = 0; $i < $max; $i++) {
		my $line = $lines[$i];
		chomp $line;
		$line = trim_all($line);
		$fline .= ' ' if length($fline);
		$fline .= $line;
		if ($fline =~ />/) {
			$fline = trim_all($fline);
			my $src = '';
			my $asrc = '';
			my $msg = '';
			# check file name - include \w, which include _, ., \, and - - more?
			if ($fline =~ /<File\sRelativePath="{1}([\.\\\w-]+)"{1}\s*>/i) {
				$src = $1;
				$asrc = fix_rel($dir.$src);
				$msg = "MISSING!";
				$msg = "ok" if ( -f $asrc);
			} elsif ($fline =~ /<File\sRelativePath="{1}(.+)"{1}\s*>/i) {
				$src = $1;
				$asrc = fix_rel($dir.$src);
				$msg = "MISSING!";
				$msg = "ok" if ( -f $asrc);
				$msg .= " *** CHECK ME *** 2";
			}
			if (length($src)) {
				my ($nm2,$dir2,$ext2) = fileparse($src, qr/\.[^.]*/ ); 
				prt( "$asrc $msg $ext2\n" ) if ($dbg1);
				my $lcex = lc($ext2);
				if (($lcex eq '.c')||($lcex eq '.cpp')||($lcex eq '.cxx')) {
					push(@srcsc, $asrc);
				}
				$fcnt++;
				if ($msg =~ /^MISSING/) {
					push(@missing, [$fil, $asrc]);
				}
			}
			$fline = '';
		}
	}
	prt("Count $fcnt ...\n");
	$srccnt += $fcnt;
}

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

sub fix_rel {
	my ($path) = shift;
	$path = unix_2_dos($path);	# ensure DOS separator
	my @a = split(/\\/, $path);	# split on DOS separator
	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 {
				$wmsg = "WARNING: Got relative .. without previous!!! [$path]";
				prt( "$wmsg\n" );
				push(@warnings,$wmsg);
			}
		} else {
			push(@na,$p);
		}
	}
	foreach my $pt (@na) {
		$npath .= "\\" if length($npath);
		$npath .= $pt;
	}
	return $npath;
}

## } elsif (lc($fil_ext) eq 'sln') {
sub process_sln {
	my ($fil) = shift;
	my ($lc, $wmsg);
	prt( "Processing SLN file [$fil] ...\n" );
	if ( !open INF, "<$fil" ) {
		$wmsg = "WARNING: Unable to open [$fil] ...";
		prt( "$wmsg\n" );
		push(@warnings, $wmsg);
		return 0;
	}
	my @lines = <INF>;
	close INF;
	$lc = scalar @lines;
	prt( "Processing $lc lines ...\n" );
	my $cnt = 0;
	my @projs = ();
	foreach $line (@lines) {
		$line = trim_all($line);
		if ($line =~ /Project\(.*=(.*)/) {
			$cnt++;
			##prt( "$1\n" );
			my @arr = split(/,/, $1);
			if (scalar @arr >= 2) {
				$arr[0] = trim_all($arr[0]);
				$arr[1] = trim_all($arr[1]);
				$arr[0] = substr($arr[0],1,length($arr[0])-2);
				$arr[1] = substr($arr[1],1,length($arr[1])-2);
				prt( "$cnt [".$arr[0]."] [".$arr[1]."] ...\n" );
				push(@projs, [ $arr[0], $arr[1] ]);
			}
		}
	}
	$cnt = scalar @projs;
	prt( "Done $lc lines ... $cnt projects ...\n" );
	##for (my $i = 0; $i < $cnt; $i++) {
	##	process_vcproj( fix_rel($fil_dir.$projs[$i][1]) );
	##}
	return @projs;
}

sub is_my_file {
	my ($f) = shift;
	my ($nm,$dir,$ext) = fileparse( $f, qr/\.[^.]*/ );
	my $lext = lc($ext);
	if (($lext eq '.c')||($lext eq '.cpp')||($lext eq '.cxx')) {
		return 1;
	}
	return 0;
}

sub process_directory { ## $in_folder
	my ($inf, $lev) = @_;
	my $rcnt = 0;
	my ($DH);
	if ( !opendir($DH, $inf) ) {
		prt( "ERROR: Unable to OPEN FOLDER [$inf] ... $! ... \n" );
		return $rcnt;
	}
	my @files = readdir($DH);
	closedir $DH;
	my $fcnt = scalar @files;
	prt( "Have $fcnt to process from $inf ...\n" ) if ($dbg3);
	foreach my $file (@files) {
		if (($file eq '.') || ($file eq '..')) {
			next;
		}
		my $ff = $inf;
		$ff .= "\\" if !($ff =~ /\\$/);
		$ff .= $file;
		if ( -d $ff ) {
			if ($recursive) {
				###if (!in_excl_list($file)) {
				$rcnt += process_directory( $ff, $lev + 1 );
			}
		} else {
			# is a FILE
			if ( is_my_file($file) ) {
				push(@dir_list, $ff);
				$rcnt++;
			}
		}
	}
	return $rcnt;
}

# eof - slnlist.pl
