Generated: Sun Apr 15 11:46:23 2012 from inctrail.pl 2012/02/07 17.9 KB.
#!/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