#!/perl -w
# NAME: inctrail.pl
# AIM: Given an in C/C++ file, check for #include "file" and #include <file>
# statements, and follow the trail, listing ALL included files, included ...
# 01/08/2010 - check it out, and add UI
# 07/10/2007 - geoff mclane - http://geoffair.net/mperl/
###################################################################
use strict;
use warnings;
use File::Basename;
use Cwd;
use File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE
my $perl_dir = 'C:\GTools\perl';
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n";
# log file stuff
our ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

my @warnings = ();
my $VERS = "0.0.2 2012-02-07";
# my $VERS = "0.0.1 2010-08-01";
my $add_more_searches = 0;
my $debug_on = 0;
my $def_file = 'C:\FGCVS\boost-trunk\boost\tr1\unordered_set.hpp';
###my $def_file = 'C:/FG/28/zlib-1.2.3/zlib.h';
###my $def_file = 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\include\winbase.h';
###my $def_file = 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\include\olectl.h';
###my $def_file = 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\include\http.h';
###my $def_file = 'C:\Program Files\Microsoft Platform SDK for Windows Server 2003 R2\include\windows.h';
###my $def_file = 'C:\FG\FGCOM\xmlrpc-c1156\lib\abyss\src\file.c';

my @included = ();
my $inccount = 0;
my %byfolder = ();
my %systemhash = ();

my $cicnt = 0;
my $addcnt = 0;
my $oldcnt = 0;
my $newcnt = 0;
my $diffcnt = 0;
my @rel_folders = ( '..\..\..', '..\..\..\include' );
my ($fin_name, $fin_folder);
my @include_folders = ();
my $incfcnt = 0;
my $load_log = 0;
my $inp_file = '';
my $base_path = '';
my $total_incs = 0;

# debug
my $dbg1 = 0;	# show all config lines
my $dbg2 = 0;	# show 'Processing ...'
my $dbg3 = 0;	# show expansionss ...
my $dbg4 = 0;	# show vc8 BAT loading ...
my $dbg5 = 0;	# show folder about to be searched
my $dbg6 = 0;	# show INVALID INCLUDE folders ...
my $dbg7 = 0;	# show ALL paths TRIED ...
my $dbg01 = 0;  # prt( "Got $lc lines of [$inf] to process ...\n" ) if ($dbg01);
my $dbg02 = 0;  # prt( "INLCUDE NOT found in environment ...\n" ) if ($dbg02);
my $dbg03 = 0;  # prt( "VALID [$fdr] ...\n" ) if ($dbg03);
my $dbg04 = 0;  # prt( "INCLUDE=[$iln]\n" ) if ($dbg04);
my $dbg05 = 0;  # prt( "Got $diffcnt from [$f] ...\n" ) if ($diffcnt || $dbg05);;
my $dbg06 = 0;  # prt( "$addcnt:$ic $line - $ifil - [$ff] - $msg\n" ) if (!$rpt && $dbg06);
my $dbg07 = 0;  # show full list of includes

my $verbosity = 0;

sub VERB1() { return ($verbosity >= 1); }
sub VERB2() { return ($verbosity >= 2); }
sub VERB5() { return ($verbosity >= 5); }
sub VERB9() { return ($verbosity >= 9); }

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

sub add_2_included {
	my ($fil, $in) = @_;
	my $lcfil = lc($fil);
	my $cicnt = scalar @included;
	for (my $j = 0; $j < $cicnt; $j++) {
		my $got = $included[$j][0];	# extract full file name
		my $lcgot = lc($got);		# to lower case
		if ($lcfil eq $lcgot) {		# if equal
			my $cin = $included[$j][2];	# get (list) of in
			my @carr = split(/\*/,$cin);	# split list
			my $fnd = 0;	# not found yet
			foreach my $tin (@carr) {	# process each in
				if ($tin eq $in) {
					$fnd = 1;	# found it
					last;
				}
			}
			if (!$fnd) {
				$cin .= '*'.$in;	# append a new 'in'
				$included[$j][2] = $cin;	# store this included in ...
			}
			return 0;				# do NOT add
		}
	}
	$inccount++;
	push(@included, [$fil, $inccount, $in]);
	return 1;
}

sub trim_comments($) {
    my ($txt) = @_;
    $txt = trim_all($txt);
    my $len = length($txt);
    my $ntxt = '';
    my ($i,$i2,$ch,$nc);
    for ($i = 0; $i < $len; $i++) {
        $i2 = $i + 1;
        $ch = substr($txt,$i,1);
        $nc = ($i2 < $len) ? substr($txt,$i2,1) : '';
        last if (($ch eq '/') && (($nc eq '/')||($nc eq '*')));
        $ntxt .= $ch;
    }
    $ntxt = trim_all($ntxt);
    return $ntxt;
}

# Join like
# dir  = C:\FGCVS\boost-trunk\boost\tr1\ to
# file = boost/tr1/detail/config.hpp
sub join_dir_to_file($$) {
    my ($dir,$fil) = @_;
    $dir = path_u2d($dir);
    $fil = path_u2d($fil);
    $dir =~ s/\\$//; # remove any trailing
    my @arr1 = split(/\\/,$dir);
    my @arr2 = split(/\\/,$fil);
    my $len1 = scalar @arr1;
    my $len2 = scalar @arr2;
    if ($len2 == 1) {
        return $dir."\\".$fil;
    }
    my $nff = '';
    my ($fold,$i,,$i2,$j,$j2);
    $j = 0;
    for ($i = 0; $i < $len1; $i++) {
        $fold = $arr1[$i];
        if ($fold eq $arr2[$j]) {
            $j++;
        }
        $nff .= "\\" if (length($nff));
        $nff .= $fold;
    }
    for (; $j < $len2; $j++) {
        $fold = $arr2[$j];
        $nff .= "\\" if (length($nff));
        $nff .= $fold;
    }
    return $nff;
}

sub process_file {
	my ($inf) = shift;
    my ($tmp);
	if (open INF, "<$inf") {
		my @lines = <INF>;
		close INF;
		my ($nm, $dir) = fileparse( $inf );
        $dir = cwd()."\\" if ($dir =~ /^\.(\\|\/)$/);
		my $lc = scalar @lines;
        prt("\n") if (VERB9());
		prt( "Got $lc lines of [$inf] to process ...\n" ) if ($dbg01 || VERB5());
		my $ic = 0;
		my $msg = '';
		my $rpt = 0;
        my $lnn = 0;
		foreach my $line (@lines) {
			chomp $line;
			$line = trim_all($line);
            $lnn++;
			if ($line =~ /^\s*\#\s*include\s+(.+)$/) {
				my $lbal = $1;
                prt("\n") if (VERB9());
                prt("Line $lnn: Found [$lbal]\n") if (VERB5());
                $lbal = trim_comments($lbal);
				my $ifil = '';
				$ic++;
                $total_incs++;
				if ($lbal =~ /<(.+)>/) {
					$ifil = $1;
				} elsif ($lbal =~ /"(.*)"/) {
					$ifil = $1;
				}
				if (length($ifil) == 0) {
					prt( "CHECK ME: line[$line] tail[$lbal] ...\n" );
					next;
				}
				my $fnd = 0;
				#$ifil =~ s/<//;
				#$ifil =~ s/>//;
				#$ifil =~ s/"//g;
				my $ff = $dir;
				$ff .= "\\" if !(substr($dir,-1) =~ /(\\|\/)/);
				$ff .= $ifil;
                $ff = path_u2d($ff);
				$msg = "FAILED";
				$rpt = 0;
				prt( "Try 1 [$ff] LOCAL\n" ) if ($dbg7 || VERB9());
				if (! -f $ff) {
                    $tmp = join_dir_to_file($dir,$ifil);
                    if ($tmp ne $ff) {
        				prt( "Try 2 [$tmp] LOCAL\n" ) if ($dbg7 || VERB9());
                        $ff = $tmp;
                    }
                }
				if (-f $ff) {
					$msg = "OK";
					my $add = add_2_included( $ff, $inf );
					if ($add) {
						$msg .= " ADDED";
						$addcnt++;
					} else {
						$msg .= " REPEAT";
						$rpt = 1;
					}
					$fnd = 1;
				} elsif ($add_more_searches) {
					# NOT found in LOCAL folder
					foreach my $rfld (@rel_folders) {
						my $ff1 = $dir;
						$ff1 .= "\\" if !(substr($ff1,-1) =~ /(\\|\/)/);
						$ff1 .= $rfld;
						$ff1 .= "\\" if !(substr($ff1,-1) =~ /(\\|\/)/);
						$ff1 .= $ifil;
						$ff1 = fix_rel($ff1);
						prt( "Trying [$ff1] RELATIVE\n" ) if ($dbg7);
						if (-f $ff1) {
							$ff = $ff1;
							$msg = "OK";
							my $add = add_2_included( $ff, $inf );
							if ($add) {
								$msg .= " ADDED";
								$addcnt++;
							} else {
								$msg .= " REPEAT";
								$rpt = 1;
							}
							$fnd = 1;
							last;
						}
					}
					if (!$fnd) {
						foreach my $ifld (@include_folders) {
							my $ff2 = $ifld;
							$ff2 .= "\\" if !(substr($ff2,-1) =~ /(\\|\/)/);
							$ff2 .= $ifil;
							prt( "Trying [$ff2] SYSTEM\n" ) if ($dbg7);
							if (-f $ff2) {
								$ff = $ff2;
								$msg = "OK";
								my $add = add_2_included( $ff, $inf );
								if ($add) {
									$msg .= " ADDED";
									$addcnt++;
								} else {
									$msg .= " REPEAT";
									$rpt = 1;
								}
								$fnd = 1;
								last;
							}
						}
					}
				}
				prt( "$addcnt:$ic $ifil - [$ff] - $msg\n" ) if ((!$rpt && $dbg06) || VERB9());
			}
		}
	} else {
		prt( "ERROR: Failed to open file [$inf] ...\n" );
	}
}

#####################################################################
######### getting the INCLUDE folders, either from the ENVIRONMENT
######### or from where MSVC8 stroes its stuff

sub load_vc8_cfg {
	my ($vc8c) = shift;
	my @v8_incs = ();
	if (open INF, "<$vc8c") {
		my @clns = <INF>;
		close INF;
		foreach my $cln (@clns) {
			chomp $cln;
			$cln = trim_all($cln);
			prt( "$cln\n" ) if ($dbg1);
			if ($cln =~ /include=\"(.+)\"/i) {
				my $iln = $1;
				my @vc8i = split(';',$iln);
				prt( "INCLUDE=[$iln]\n" ) if ($dbg04);
				foreach my $itm (@vc8i) {
					push(@v8_incs, $itm);
				}
			}
		}
	} else {
		prt( "WARNING: can not open [$vc8c] ... $! ...\n" );
	}
	return @v8_incs;
}


sub load_vc8_bat {
	my ($vc8b) = shift;
	my @v8_folders = ();
	my @v8_incs = ();
	my %v8_hash = ();
	if (open INB, "<$vc8b") {
		my @lns = <INB>;
		close INB;
		foreach my $ln (@lns) {
			chomp $ln;
			$ln = trim_all($ln);
			if ($ln =~ /\@*SET\s+(.*)/) {
				my @arr = split(/=/,$1);
				my $sz = scalar @arr;
				if ($sz == 2) {
					my $ky = uc($arr[0]);
					my $val = $arr[1];
					$v8_hash{$ky} = $val;
					prt( "[$ky]=[$val]\n" ) if ($dbg4);
					if ($ky =~ /^VCINSTALLDIR$/i) {
						# got the INSTALL DIECTORY
						my $vc8_cfg = $val. "\\vcpackages\\vcprojectengine.dll.config";
						if (-f $vc8_cfg) {
							@v8_incs = load_vc8_cfg($vc8_cfg);
						} else {
							prt( "WARNING: [$vc8_cfg] does not exist ...\n" );
						}
					}

				} else {
					prt( "SET $1\n" );
				}
			}
		}
		foreach my $item (@v8_incs) {
			# expand
			if ($item =~ /.*\$\((.+)\).+/) {
				my $eit = uc($1);
				prt( "Item [$eit] in [$item] needs expansion ...\n" ) if ($dbg3);
				foreach my $key (keys %v8_hash) {
					if ($key eq $eit) {
						$item =~ s/\$\($key\)/$v8_hash{$key}\\/i;
						prt( "New item = [$item] ...\n" ) if ($dbg3);
						last;
					}
				}
			}
			push(@v8_folders, $item) if (length($item));
		}
	} else {
		prt( "WARNING: No open of [$vc8b] ... $! ...\n" );
	}
	return @v8_folders;
}

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


sub get_INCLUDE_Folders {
	my ($inf) = shift;	# this is the LOCAL folder
	my @fldrs1 = ();
	my @fldrs2 = ();
	my @fldrs3 = ();
	my @fldrsok = ();
	my $okcnt = 0;
	my $failed = 0;
	my $valcnt = 0;
	my $envstg = $ENV{"INCLUDE"};	# check INLCUDE in environment
	my $vc8_env = $ENV{"VS80COMNTOOLS"};
	my $psdk = $ENV{"PSDK_DIR"};
	my $dxsdk = $ENV{"DXSDK_DIR"};	# =C:\Program Files\Microsoft DirectX SDK (October 2006)\
	my $fdr = '';
    my ($cnt);
	if (defined $envstg) {
		@fldrs1 = split(';',$envstg);
	} else {
		prt( "INLCUDE NOT found in environment ...\n" ) if ($dbg02);
	}
	if (defined $vc8_env) {
		# we have MSVC8
		my $vc8_bat = $vc8_env . "vsvars32.bat";
		if (-f $vc8_bat) {
			push(@fldrs2, load_vc8_bat($vc8_bat));
		} else {
			prt( "WARNING: [$vc8_bat] not found ...\n" );
		}
	}
	if (defined $psdk) {
		push(@fldrs3,$psdk);
	} else {
		prt( "PSDK_DIR NOT found in environment ...\n" ) if ($dbg02);
	}
	if (defined $dxsdk) {
		push(@fldrs3,$dxsdk);
	} else {
		prt( "DXSDK_DIR NOT found in environment ...\n" ) if ($dbg02);
	}
	foreach $fdr (@fldrs1) {
		if (-d $fdr) {
			push(@fldrsok, $fdr) if (!same_folder($fdr,$inf));
			prt( "VALID [$fdr] ...\n" ) if ($dbg03);
			$valcnt++;
		} else {
			prt( "Discarding [$fdr] as INVALID ...\n" ) if ($dbg6);
			$failed++;
		}
	}
	foreach $fdr (@fldrs2) {
		if (-d $fdr) {
			push(@fldrsok, $fdr) if (!same_folder($fdr,$inf));
			prt( "VALID [$fdr] ...\n" ) if ($dbg03);
			$valcnt++;
		} else {
			prt( "Discarding [$fdr] as INVALID ...\n" ) if ($dbg6);
			$failed++;
		}
	}
	foreach $fdr (@fldrs3) {
		if (-d $fdr) {
			push(@fldrsok, $fdr) if (!same_folder($fdr,$inf));
			prt( "VALID [$fdr] ...\n" ) if ($dbg03);
			$valcnt++;
		} else {
			prt( "Discarding [$fdr] as INVALID ...\n" ) if ($dbg6);
			$failed++;
		}
	}
	$okcnt = scalar @fldrsok;
	prt( "get_INCLUDE_Folders: Found $okcnt ($valcnt) folders, and $failed failed ...\n" );
    $cnt = 0;
    foreach $fdr (@fldrsok) {
        $fdr .= "\\" if ( !($fdr =~ /(\\|\/)$/) );
        $fdr = unix_2_dos($fdr);
        if (! defined $systemhash{$fdr}) {
            $cnt++;
            $systemhash{$fdr} = "System$cnt";
        }
    }
	return @fldrsok;
}

#####################################################################

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 $wmsg = '';
	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;
}


sub same_folder {
	my ($fd1, $fd2) = @_;
	$fd1 = unix_2_dos($fd1);
	$fd2 = unix_2_dos($fd2);
	$fd1 =~ s/\\$//;
	$fd2 =~ s/\\$//;
	my $lfd = length($fd1);
	if ($lfd != length($fd2)) {
		return 0;	# NOT same length
	}
	for (my $k = 0; $k < $lfd; $k++) {
		if (lc(substr($fd1,$k,1)) ne lc(substr($fd2,$k,1))) {
			return 0;	# different
		}
	}
	return 1;	# ARE THE DOS SAME
}

sub set_INCLUDE_Folders($) {
    my ($inf) = @_;
    ($fin_name, $fin_folder) = fileparse($inf);
    @include_folders = get_INCLUDE_Folders($inf);
    $incfcnt = scalar @include_folders;
    # prt( "Got $incfcnt INCLUDE folders ...\n" );
}

sub get_system_num($) {
    my ($fil) = @_;
    my ($n,$d) = fileparse($fil);
    $d = unix_2_dos($d);
    if (defined $systemhash{$d}) {
        return $systemhash{$d}."\\".$n;
    }
    return $fil;
}

sub process_files($) {
    my ($inf) = @_;
    my ($i,$f,$ord);
    my ($nam,$dir);
    my ($fnms,@nms,@nmss);

    process_file($inf);

    $cicnt = scalar @included;
    prt( "Of total $total_incs, found $cicnt from [$inf] ...\n" );

    for ($i = 0; $i < $cicnt; $i++) {
        $f = $included[$i][0];
        $ord = $included[$i][1];
        $oldcnt = scalar @included;
        process_file($f);
        $newcnt = scalar @included;
        $diffcnt = $newcnt - $oldcnt;
        $f = get_system_num($f);
        prt( "Got $diffcnt from [$f] ...\n" ) if ($diffcnt || $dbg05);
    }

    $cicnt = scalar @included;
    while ($i < $cicnt) {
        $f = $included[$i][0];
        $ord = $included[$i][1];
        $oldcnt = scalar @included;
        process_file($f);
        $i++;
        $cicnt = scalar @included;
        $diffcnt = $cicnt - $oldcnt;
        $f = get_system_num($f);
        prt( "Got $diffcnt from [$f] ...\n" ) if ($diffcnt || $dbg05);
    }

    prt( "Got TOTAL $total_incs includes from [$inf] ... found $cicnt\n" );
    for ($i = 0; $i < $cicnt; $i++) {
        $f = $included[$i][0];
        $ord = $included[$i][1];
        ($nam, $dir) = fileparse($f);
        if (defined $byfolder{$dir}) {
            $byfolder{$dir} .= '*'.$nam;
        } else {
            $byfolder{$dir} = $nam;
        }
        $f = get_system_num($f);
        prt( "$ord $f\n" ) if ($dbg07);
    }
    prt("\n") if ($dbg07 || VERB9());

    prt( "BY FOLDER - TOTAL $cicnt includes from [$inf] ...\n" );
    foreach $dir (sort (keys(%byfolder))) {
        $fnms = $byfolder{$dir};
        @nms = split(/\*/,$fnms);
        @nmss = sort @nms;
        prt( "$dir - ".scalar @nms." headers ...\n" );
        prt( join(", ", @nmss)."\n" );
    }

}

#################################################################
### MAIN ###

# prt( "$0 ... Hello, World ...\n" );

parse_args(@ARGV);

set_INCLUDE_Folders($inp_file);

process_files($inp_file);

pgm_exit(0,"");

##############################################################

sub give_help {
    prt("$pgmname: version $VERS\n");
    prt("Usage: $pgmname [options] input_header_file\n");
    prt("Options:\n");
    prt(" -h (-?) = This help and exit 0");
    prt(" -l      = Load log at end.\n");
    prt("Parse input header for includes, and parse those includes, listing\n");
    prt("ALL the include files found...\n");
}


sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg eq '?')||($sarg =~ /^h/i)) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^l/i) {
                $load_log = 1;
            } else {
                pgm_exit(1,"ERROR: Unknown argument [$arg]\n");
            }
        } else {
            $inp_file = $arg;
        }

        shift @av;
    }

    if ($debug_on && (length($inp_file) == 0)) {
        $inp_file = $def_file;
        $verbosity = 9;
        $load_log = 1;
    }

    if (length($inp_file) == 0) {
        pgm_exit(1,"ERROR: No input file detected in command line!");
    }

    $arg = File::Spec->rel2abs($inp_file);
    if (($arg ne $inp_file)&&(length($arg) > length($inp_file))) {
        $base_path = substr($arg,0,(length($arg) - length($inp_file)));
        ### pgm_exit(1,"Set base path [$base_path]\n");
    }
    $inp_file = $arg;
    if (! -f $inp_file) {
        pgm_exit(1,"ERROR: Can NOT locate input file [$inp_file]!");
    }
}

# eof - inctrail.pl
