#!/perl -w
# NAME: dswlist.pl
# AIM: Given a MSVC6 DSW files, show the LIST of DSP files it references
# or given a FOLDER, search for ALL .DSW files, and show .DSP list.
#
# 22/04/2007 - geoff mclane - http://geoffmclane.com/mperl/samples/index.htm
use strict;
use warnings;
use File::Basename;
#use Cwd qw(chdir abs_path);
######################################################################################
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);

my $recursive = 1;
my $show_rel = 1;
my $fix_rela = 1;
my $show_srcs = 1;	# read the DSP, and show the SOURCES contained
my $dbg_on = 1;	# to run without a command line
my $dbg1 = 0;	# show Project line during collection
my $dbg2 = 0;	# show during collection
my $dbg3 = 0;	# show during folder collection
my $dbg4 = 0;	# show Processing 
my $base_dir = "C:\\FG\\FGCOM";
##my $base_dir = "C:\\FG\\10\\freeglut"; #\\progs\\demos\\";
##my $base_dir = "C:\\Projects\\UltraVNC-102-Src\\UltraVNC";
#my $def_input = $base_dir."demos.dsw"; # adjust this to the file you want parsed
my $def_input = $base_dir; #."\\freeglut.dsw"; # adjust this to the file you want parsed
my $in_file = '';
my @files = ();
my @file_list = ();
my $pcnt = 0;
my $line = '';
my $wmsg = '';
my $dswcnt = 0;
my @warnings = ();
if ($dbg_on) {
	$in_file = $def_input;
}

prt( "$0 ... Using in file [$in_file] ...\n" );
if ( -f $in_file) {
	process_dsw( $in_file );
} elsif ( -d $in_file ) {
	process_directory( $in_file, 0 );
	$dswcnt = scalar @file_list;
	prt( "Found $dswcnt DSW files to process ...\n" );
	foreach $line (@file_list) {
		process_dsw( $line );
	}

} else {
	$wmsg = "WARNING: [$in_file] is NOT file or directory ...";
	prt( "$wmsg\n" );
}

close_log($outfile,1);
exit(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 . "\\" . $file;
		if (-d $ff) {
			if ($recursive) {
				###if (in_excl_list($file)) {
				###	push(@folders, sub_main($ff));
				###}
				$rcnt += process_directory( $ff, $lev + 1 );
			}
		} else {
			# is a FILE
			if ( is_my_file($file) ) {
				push(@file_list, $ff);
				$rcnt++;
			}
		}
	}
	return $rcnt;
}

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

# ENSURE '/' is used throughout string.
sub dos_to_unix {
	my ($du) = shift;
	$du =~ s/\\/\//g;
	return $du;
}

sub scan_dsp {
	my @dsplines = @_;
	my $lncnt = scalar @dsplines;
	my @dspsrcs = ();
	###prt( "File contains $lncnt lines ...\n" );
	foreach $line (@dsplines) {
		chomp $line;
		if ($line =~ /^#\s+TARGTYPE\s+(.*)/) {
			prt( "# TARGTYPE $1\n" );
	    } elsif ( $line =~ /^#\s+Begin\s+Group\s+(.*)/ ) {
			prt( "# Begin Group $1\n" );
		} elsif ( $line =~ /^SOURCE=/ ) {
			$line =~ s/^SOURCE=//o;
			while ($line =~ /\W$/) { # ending in NON-alphanumic
				####prt( "Discarding [".substr($line,-1,1)."]!\n" );
				$line = substr($line,0,length($line)-1);
			}
			##while (( substr($line,-1,1) eq ' ' )||( substr($line,-1,1) eq "\t")||
			##	( substr($line,-1,1) eq "\r")||( substr($line,-1,1) eq "\n")) {
			##	$line = substr($line,0,length($line)-1);
			##}
			$line =~ s/^\"//; # remove leading inverted commas
			$line =~ s/\"$//; # remove trailing inverted commas
			$line = dos_to_unix($line);
			$line =~ s/^\.\///;
			if (($line =~ /\.cxx$/i) || ($line =~ /\.c$/i) || ($line =~ /\.cpp$/i)) {
				push(@dspsrcs, $line);
			} else {
				if ( !(($line =~ /\.hxx$/i) || ($line =~ /\.h$/i) || ($line =~ /\.hpp$/i)) ) {
					if ( !($line =~ /^\$\(/) ) {
						prt( "CHECK Discarded [$line]\n" );
					}
				}
			}
		}
	}
	$lncnt = scalar @dspsrcs;
	prt( "File contains $lncnt SOURCES ...\n" );
	return @dspsrcs;
}


sub show_files {
	my (@fils) = @_;
	my $cnt = 0;
	foreach $line (@fils) {
		$cnt++;
		my $rp = substr($line, length($base_dir));
		if ($show_rel) {
			if ($fix_rela) {
				$rp = fix_rel($rp);
			}
			prt( "$cnt $rp\n" );
		} else {
			prt( "$line\n" );
		}
		if ($show_srcs) {
			# read the DSP, and enumerate the SOURCES
			if (open(INF, "<$line")) {
				my @lns = <INF>;
				close INF;
				my $lncnt = scalar @lns;
				prt( "$line contains $lncnt lines to process ...\n" );
				my @srcs = scan_dsp(@lns);
				foreach my $src (@srcs) {
					prt( "   $src\n" );
				}
			} else {
				prt( "WARNING: Failed to open [$line] ...\n" );
			}
		}
	}
}

sub process_dsw {
	my ($fl) = shift;
	my @fls = load_in_file( $fl );
	prt( "\nFrom $fl got ".scalar @fls." DSP files ...\n" );
	show_files( @fls );
}

sub load_in_file {
	my ($inf) = shift;
	my @infs = ();
	###prt( "Processing $inf ...\n" );
	if ( !open INF, "<$inf" ) {
		$wmsg = "WARNING: Can not OPEN [$inf] ... $! ...";
		prt( "$wmsg\n" );
		push(@warnings, $wmsg);
		return @infs;
	}
	my @lines = <INF>;
	close INF;
	my $cnt = scalar @lines;
	my ($nm,$dir) = fileparse($inf);
	prt( "\nProcessing $cnt lines from [$nm] in [$dir] ...\n" ) if ($dbg4);
	$cnt = 0;
	foreach $line (@lines) {
		$line = trim_all($line);
		###if ($line =~ /Project:\s+\"{1}(.+)\"{1}/) {
		if ($line =~ /Project:\s+(.+)\s+-\s+Package\s+Owner=/) {
			$cnt++;
			prt( "$cnt Project [$1] ...\n" ) if ($dbg1);
			my $proj = $1;
			$proj =~ s/\"//g;
			my @arr = split(/=/, $proj);
			if (scalar @arr >= 2) {
				$pcnt++;
				my $dsp = $dir . $arr[1];
				my $ok = 'NOT FOUND';
				if ( -f $dsp) {
					$ok = 'ok';
				}
				prt( "$pcnt name=[".$arr[0]."], file=[".$arr[1]."] ...$ok \n" ) if ($dbg2);
				push(@infs, $dsp);
			}
		}
	}
	$cnt = scalar @infs;
	prt( "Got $cnt files from $inf ...\n" ) if ($dbg4);
	return @infs;
}

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

sub fix_rel {
	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;
}

sub die_if_no_file {
	my ($fil) = shift;
	if ((length($fil) == 0) || !( -f $fil )) {
		if (length($fil)) {
			mydie( "ERROR: Can NOT locate [$fil] ... $! ...\n" );
		} else {
			mydie( "ERROR: Must give a DSW input file ...\n" );
		}
	}
}

# eof - dswlist.pl
