#!/perl -w
# NAME: vc_sln.pl
# AIM: Scan a SLN file, and report contents
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[.]*/] )
use Cwd;
unshift(@INC, 'C:\GTools\perl');
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
    my @tmpsp = split(/\\/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $perl_dir = 'C:\GTools\perl';
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $debug_on = 0;   # run in EditPlus
my $def_file = 'C:\Projects\fltk-1.1.10\vc2005\fltk.sln';

my $load_log = 1;
my $in_file = '';
my $show_depends = 0;
my $show_projects = 0;

### DEBUG
my $dbg_sl_01 = 0; # prt( "Got PROJECT name=$projname, file=[$projfile], ff=[$projff], rel=[$relpath].\n" ) if ($dbg_sl_01);
my $dbg_sl_02 = 0; # prt( "$pgmname: Proj $projname, dependant on $arr[0] ...\n" ) if ($dbg_sl_02);
my $dbg_sl_03 = 0; # prt( "$pgmname: proj $projname, depends on $nmdeps ...\n" ) if ($dbg_sl_03);

sub set_dbg_flags($) {
    my ($v) = shift;
    $dbg_sl_01 = $v; $dbg_sl_02 = $v; $dbg_sl_03 = $v;
}

sub set_dbg_on() { set_dbg_flags(1); }
sub set_dbg_off() { set_dbg_flags(0); }

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my ($sln_file_nm,$sln_root_dir,$sln_file_ext);

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg)
    }
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

sub show_warnings() {
   if (@warnings) {
      prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
      foreach my $itm (@warnings) {
         prt("$itm\n");
      }
      prt("\n");
   } else {
      prt( "\nNo warnings issued.\n\n" );
   }
}

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

# Read and store contents of SOLUTION (.sln) file
# 22/04/2008 - Extract DEPENDENCIES from solution file, and add to DSW output
sub process_SLN_file3($) {
	my ($sln_fil_in) = shift;
	my ($cnt, $line, $vers, @arr, $mver, $par, $ff, $itmnum);
	my ($projname, $projfile, $projff, $gotproj, $relpath);
	my ($tnm,$tpth);
	my ($inproj, $tline, $projid, $inpdeps, $projdeps);
    my ($nmdeps, $depid, $pn);
    my ($msg,$text,$dspfile,$fdspfil);
    my $fil = $sln_fil_in;
	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); # get the NAME, and SOLUTION PATH (should be ABSOLUTE, NOT relative)
    $sln_path = cwd() if ($sln_path =~ /^\.(\\|\/)$/);
    $sln_path .= "\\" if (!($sln_path =~ /(\\|\/)$/));
    $sln_path =~ s/\//\\/g; # all to DOS
    my %sln_projects = ();
    my %sln_projpath = ();
    my %sln_depends = ();
    my %sln_projids = ();
	prt( "\nProcessing $cnt lines ... n=[$name] p=[$sln_path] ...\n" );
	$projname = '';
	$projfile = '';
	$projff = '';
	$gotproj = 0;
	$inproj = 0;
	$inpdeps = 0;
	foreach $line (@lines) {
		$tline = trim_all($line);
		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*\(/) {
			# seek like 
			#Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "abyss", "abyss.vcproj", "{8B384B8A-2B72-4DC4-8DF1-E3EF32F18850}"
			###prt( "Got project [$line] ...\n" );
			$inproj = 1;
			@arr = split( '=', $line );
			$cnt = scalar @arr;
			if ($cnt == 2) {
				$par = $arr[1]; # get 2nd part, like say '"abyss", "abyss.vcproj", "{8B384B8A-2B72-4DC4-8DF1-E3EF32F18850}"'
				@arr = split(',', $par);
				$cnt = scalar @arr;
				if ($cnt == 3) {
					$projname = strip_quotes(trim_all($arr[0]));
					$projfile = strip_quotes(trim_all($arr[1]));
					$projid   = strip_quotes(trim_all($arr[2]));
					$projff   = fix_rel_path3($sln_path.$projfile,'process_SLN_file3'); # return ABSOLUTE
					if ((length($projname)) && (is_vcproj_ext($projfile)) && (-f $projff)) {
						$gotproj = 1;
						($tnm,$tpth,$text) = fileparse($projff,qr/\.[^.]*/);
                        $fdspfil = $tpth.$tnm.".dsp";
						$relpath = get_rel_dos_path($tpth, $sln_path);
						($tnm,$tpth,$text) = fileparse($projfile,qr/\.[^.]*/);
                        $dspfile = $tpth.$tnm.".dsp";
						prt( "Got PROJECT name=$projname, file=[$projfile], ff=[$projff], rel=[$relpath].\n" ) if ($dbg_sl_01);
						if (defined $sln_projects{$projname}) {
							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/'
                            #                           0         1       2        3        4
							$sln_projpath{$projname} = [$projfile,$projff,$relpath,$dspfile,$fdspfil]; # relative project file, like '..\alut\path\alut.vcproj'
							$sln_projids{$projname}  = $projid;
							$sln_depends{$projname}  = '';	# start dependencies, if any
						}
                        ### pgm_exit(1,"TEMP EXIT");
					} else {
						$msg = "WARNING: ";
						if (!length($projname)) {
							$msg .= "Failed to get a project name! ";
						} elsif ( !is_vcproj_ext($projfile) ) {
							$msg .= "Name [$projfile] NOT a VCPROJ name! ";
						} else {
							$msg .= "Unable to locate file [$projff]! ";
						}
						$msg .= " Line is (trimmed)\n$tline";
                        prtw("$msg\n");
					}
				} else {
					prtw( "Warning: Part 2 of Project line did NOT split into 3 on comma!???\n" );
				}
			} else {
				prtw( "Warning: Project line did NOT split in 2 on equal sign!???\n" );
			}

			# to switch on $tryharder requires additional work on parsing this line
			# =====================================================================
			prtw("WARNING: line [$line] ...\n") if (!$gotproj);
			# =====================================================================
		} elsif ($inproj) {
			# in the Project section - look for END of section, and DEPENDENCIES
			# ProjectSection(ProjectDependencies)
			if ($tline eq 'EndProject') {
			###if ($line =~ /^EndProject\s*/)
				$inproj = 0;
			} else {
				if ($inpdeps) {
					if ($tline eq 'EndProjectSection' ) {
						$inpdeps = 0;
					} else {
						# collect dependencies
						@arr = split( '=', $line );
						$cnt = scalar @arr;
						if ($cnt == 2) {
							$arr[0] = trim_all($arr[0]);
							$arr[1] = trim_all($arr[1]);
							if ($arr[0] eq $arr[1]) {
								$projdeps = $sln_depends{$projname};	# extract dependencies, if any
								$projdeps .= '|' if (length($projdeps));
								$projdeps .= $arr[0];
								prt( "$pgmname: Proj $projname, dependant on $arr[0] ...\n" ) if ($dbg_sl_02);
								##prt( "Proj $projname, dependant on $projdeps ...\n" );
								$sln_depends{$projname} = $projdeps;
							} else {
								prtw( "Warning: Found different IDS '$arr[0]' NE '$arr[1]'!!! \n" );
							}
						} else {
							prtw( "Warning: Project DEPENDENCY line did NOT split in 2 on equal sign!???\n" );
							prtw( "line=$line" );
						}
					}
				} elsif ($line =~ /ProjectSection\s*\(\s*ProjectDependencies\s*\)/) {
					$inpdeps = 1;
				}
			}
		}
	}
	###prt( "Done $fil ... got ".scalar @proj_files." project files ...\n" );
	prt( "Done $fil ... got ".scalar keys(%sln_projects)." project files ...\n" );
	# resolve dependencies, if possible - warn if NOT ...
	# resolve_depends();
	foreach $projname (keys %sln_projects) {
		$projdeps = $sln_depends{$projname};
		if (length($projdeps)) {
			# there is LENGTH, convert giant CID to simple project names
			@arr = split( /\|/, $projdeps );	# split em up
			$cnt = scalar @arr;	# get count of split
			#prt( "Proj $projname, depends on $cnt = $projdeps ...\n" );
			$nmdeps = '';	# build simple NAME set
			foreach $depid (@arr) {
				foreach $pn (keys %sln_projids) {
					if ($pn ne $projname) {
						$projid = $sln_projids{$pn};
						if ($depid eq $projid) {
							$nmdeps .= '|' if (length($nmdeps));
							$nmdeps .= $pn;
							last;
						}
					}
				}
			}
			@arr = split( /\|/, $nmdeps );
			prt( "$pgmname: proj $projname, depends on $nmdeps ...\n" ) if ($dbg_sl_03);
			if ($cnt != scalar @arr) {	# YEEK - Does NOT match - OH WELL
				prtw( "WARNING: Failed to get SAME count $cnt - got ".scalar @arr."!\n" );
			}
			$sln_depends{$projname} = $nmdeps;
		}
	}
    # ====================================================================
    my %hash = ();
    $hash{'SOLUTION'} = $fil;   # keep the SOLUTION files also
    $hash{'SLNPATH'}  = $sln_path;  # and its PATH
    $hash{'PROJECTS'} = { %sln_projects };
    $hash{'PROJPATH'} = { %sln_projpath };  # array refs [$projfile,$projff,$relpath]
    $hash{'DEPENDS'}  = { %sln_depends  };
    $hash{'PROJIDS'}  = { %sln_projids };
    # =====================================================================
    return \%hash;
}


sub process_sln_file($) {
    my ($in) = @_;
    ($sln_file_nm,$sln_root_dir,$sln_file_ext) = fileparse($in, qr/\.[.]*/);
    my $rsh = process_SLN_file3($in);
    prt( "$pgmname: KEYS in SLN hash = " );
    my ($k,$v,$k2,$v2,$min,$len,$dep,$tmp);
    my %hash = ();
    my (@arr,$cnt,@none);
    foreach $k (keys %{$rsh}) { prt( "$k " ); }
    prt("\n");
    if ($show_depends) {
        $k = 'DEPENDS';
        if (defined ${$rsh}{$k}) {
            $v = ${$rsh}{$k};
            $min = 0;
            foreach $k2 (keys %{$v}) {
                $len = length($k2);
                $min = $len if ($len > $min);
            }
            @none = ();
            foreach $k2 (keys %{$v}) {
                $v2 = ${$v}{$k2};
                $tmp = $k2;
                $tmp .= ' ' while (length($tmp) < $min);
                if (defined($v2) && length($v2) && !($v2 =~ /^\s$/)) {
                    prt("$tmp -> [$v2]\n");
                    @arr = split(/\|/,$v2);
                    foreach $dep (@arr) {
                        if (defined $hash{$dep}) {
                            $hash{$dep}++;
                        } else {
                            $hash{$dep} = 1;
                        }
                    }
                } else {
                    prt("$tmp -> <none>\n");
                    push(@none,$k2);
                }
            }
            $cnt = scalar keys(%hash);
            prt("Total of $cnt dependents...\n");
            foreach $k (keys %hash) {
                $v = $hash{$k};
                prt("$k($v) ");
            }
            prt("\n") if ($cnt);
        }
    }

    if ($show_projects) {
        $k = 'PROJECTS';
        if (defined ${$rsh}{$k}) {
            $v = ${$rsh}{$k};
            $min = 0;
            $cnt = 0;
            foreach $k2 (keys %{$v}) {
                $len = length($k2);
                $min = $len if ($len > $min);
                prt("$k2 ");
                $cnt++;
            }
            if ($cnt) {
                prt("\nAbove is list of $cnt projects...\n");
            }
        }
    }
}

#########################################
### MAIN ###
parse_args(@ARGV);
#prt( "$pgmname: in [$cwd]: Hello, World...\n" );
process_sln_file($in_file);
pgm_exit(0,"Normal exit(0)");
########################################
sub give_help {
    prt("$pgmname: version 0.0.1 2010-05-05\n");
    prt("Usage: $pgmname [options] input_sln_file\n");
    prt("Options:\n");
    prt(" -h (-?)  = This help, and exit(0)\n");
    prt(" -d       = show depends.\n");
    prt(" -p       = show project list.\n");
    prt(" -debug   = Turn on ALL debug flags.\n");
    prt("Purpose: Read input file as a solution file, and\n");
    prt("         show its contents.\n");
}
sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have follwoing argument!\n")
        if (!@av);
}
sub parse_args {
    my (@av) = @_;
    while (@av) {
        my $arg = $av[0];
        if ($arg =~ /-/) {
            my $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^d/i) {
                if ($sarg =~ /^degbug$/) {
                    set_dbg_on();
                    prt("Set all debug on...\n");
                } else {
                    $show_depends = 1;
                    prt("Set show depends.\n");
                }
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = $arg;
            prt("Set input to [$in_file]\n");
        }
        shift @av;
    }
    if (length($in_file)) {
        if (! -f $in_file) {
            pgm_exit(1,"ERROR: No input file given!");
        }
    } else {
        if ($debug_on && length($def_file) && (-f $def_file)) {
            $in_file = $def_file;
            prt("Set input to DEFAULT [$in_file]\n");
            #set_dbg_on();
            $show_depends = 1;
            $show_projects = 1;
        } else {
            pgm_exit(1,"\nERROR: No input file given!\n\n");
        }
    }
}

# eof - vc_sln.pl
