Generated: Sun Apr 15 11:46:23 2012 from inctrail02.pl 2012/02/07 21.1 KB.
#!/perl -w # NAME: inctrail02.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 ... # 07/02/2012 - Exlude the $def_file if not $debug_on # 2010/04/25 - avoid duplicate header output # 20090817 - add input argument support # 02/08/2008 - skip over C and inline comments in headers ... # 20/12/2007 - Process EACH include as and when FOUND # 07/10/2007 - geoff mclane - http://geoffair.net/mperl/ ################################################################### 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"; require 'fgutils02.pl' or die "Unable to load fgutils02.pl!\n"; require 'getvcdirs.pl' or die "Unable to load getvcdirs.pl!\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $perl_root = 'C:/GTools/perl'; my $outfile = $perl_root."\\temp.$pgmname.txt"; open_log($outfile); # prt( "$0 ... Hello, World ...\n" ); # features my $show_rel_warnings = 0; my $avoid_dup_headers = 1; # only output each header ONCE my $load_log = 0; my @excluded_incs = qw( macwin32.h rpcmac.h ); my @excluded_bgns = qw( X11 ); # debug my $debug_on = 0; 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 $verb3 = 0; # show sorting my $dbg8 = 0; # show "\nGot $lc lines of [$inf] to process ... my $dbg9 = 0; # show "$addcnt:$ic $line - $ifil - [$ff] - $msg my $dbg10 = 0; # show "Found $ic in [$inf] ... my $dbg_i20 = 0; # prt("[dbg_i20] Found $okcnt 'vc' directories...\n") if ($dbg_i20); and MORE my $dbg_i21 = 0; # prt( "[dbg_i21] $ord $f - ok\n" ) if ($dbg_i21); my $dbg_i22 = 0; # prt( "[dbg_i22] ".join(", ", @nmss)."\n" ) if ($dbg_i22); my $verbosity = 0; sub VERB1() { return ($verbosity >= 1); } sub VERB2() { return ($verbosity >= 2); } sub VERB5() { return ($verbosity >= 5); } sub VERB9() { return ($verbosity >= 9); } my $os = $^O; my @warnings = (); my $fin_file = ''; my $def_file = 'C:\GTools\samples\ATI_D3D9_OpenGL\OpenGL\Framebuffer_object\App.cpp'; my @included = (); my $inccount = 0; my %byfolder = (); my @foundlst = (); my $cicnt = 0; my $addcnt = 0; my $oldcnt = 0; my $newcnt = 0; my $diffcnt = 0; my @rel_folders = ( '..\..\..', '..\..\..\include' ); my @include_folders = (); my ($fin_name, $fin_folder); # constants my $I_NFD = 0; # NOT found my $I_LOC = 1; # found locally my $I_REL = 2; # found in relative search my $I_SYS = 3; # found in VC include folder # forward sub process_file($$); sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings($) { my ($val) = shift; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS ...\n" ); foreach my $line (@warnings) { prt("$line\n" ); } prt("\n"); } elsif ($val) { prt("\nNo warnings issued.\n\n"); } } sub pgm_exit($$) { my ($val,$msg) = @_; show_warnings($val); if (length($msg)) { $msg .= "\n" if !($msg =~ /\n$/); prt($msg); } close_log($outfile,$load_log); # unlink($outfile); # delete output file exit($val); } sub check_file_dir($) { my ($rinfd) = shift; if ( ! (${$rinfd} =~ /(\\|\/)$/) ) { ${$rinfd} = cwd(); if ( ! (${$rinfd} =~ /(\\|\/)$/) ) { ${$rinfd} .= "\\"; } } } sub os_is_windows() { return 1 if ($os =~ /^MSWin32$/i); return 0; } sub sub_common_folder_dos { my ($f1, $f2) = @_; my $df1 = path_u2d($f1); my $df2 = path_u2d($f2); if (os_is_windows()) { $df1 = lc($df1); $df2 = lc($df2); } my $len = length($df1); $len = length($df2) if (length($df2) < $len); # paddle across, stopping at first difference my $off = 0; my ($i,$ch1,$ch2); for ($i = 0; $i < $len; $i++) { $ch1 = substr($df1,$i,1); $ch2 = substr($df2,$i,1); last if ($ch1 ne $ch2); $off++; } #while ( substr($df1,$off,1) && substr($df2,$off,1) && # ( substr($df1,$off,1) eq substr($df2,$off,1) ) ) { # $off++; #} #prt("Sub [$f1]\nFrm [$f2] $off\n") if (VERB9()); return substr($f1,$off); } sub sub_in_folder($) { my ($p) = shift; #prt("Sub [$fin_folder]\nFrm [$p]\n") if (VERB9()); $p = sub_common_folder_dos($p,$fin_folder); $p =~ s/^(\\|\/)//; # kick off any leading '\' or '/' - 2010-04-02 #prt("Got [$p]\n") if (VERB9()); return $p; } sub get_INCLUDE_Folders { my ($inf) = shift; # this is the LOCAL folder my $okcnt = 0; my @fldrsok = (); my $rvca = get_vc8_dirs3(); my $fdr = ''; $okcnt = scalar @{$rvca}; if ($okcnt) { prt("[dbg_i20] Found $okcnt 'vc' directories...\n") if ($dbg_i20); $okcnt = 0; foreach my $dir (@{$rvca}) { $fdr = 'NF'; if (-d $dir) { $okcnt++; push(@fldrsok,$dir); $fdr = 'ok'; } prt("[dbg_i20] [$dir] $fdr\n") if ($dbg_i20); } if ($okcnt) { return @fldrsok; } } pgm_exit(1,"ERROR: Failed to find 'system' includes! Aborting..."); } sub is_excluded_inc($) { my ($fil) = shift; my $osw = os_is_windows(); $fil = lc($fil) if ($osw); my ($f); foreach $f (@excluded_incs) { # like macwin32.h $f = lc($f) if ($osw); return 1 if ($fil eq $f); } foreach $f (@excluded_bgns) { # like x11 return 1 if ($fil =~ /^$f(\/|\\)/i); } return 0; } sub unix_2_dos { my ($f) = shift; $f =~ s/\//\\/g; return $f; } # fix relative path sub fix_rel($) { # fixed 26/12/2007 to remove '\\' entries 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 { if ($show_rel_warnings) { $wmsg = "WARNING: Got relative .. without previous!!! [$path]"; prtw( "$wmsg\n" ); } } } elsif (length($p)) { # added 26/12/2007 push(@na,$p); } } foreach my $pt (@na) { $npath .= "\\" if length($npath); $npath .= $pt; } return $npath; } sub add_2_found_list($$$$) { my ($inf,$ic,$fls,$locs) = @_; my ($nm, $dir) = fileparse($inf); # ignore pshpack, and poppack return 0 if ($nm =~ /^pshpack/i); return 0 if ($nm =~ /^poppack/i); my $cnt = scalar @foundlst; for (my $f = 0; $f < $cnt; $f++) { my $ff = $foundlst[$f][1]; if (is_same_file($inf, $ff)) { return 0; } } push(@foundlst, [$ic,$inf,$fls,$locs]); return 1; } sub process_file($$) { my ($inf, $lev) = @_; my $ic = 0; my $inc_fils = ''; # list of files included by this file my $inc_locs = ''; # equivalent list of where each was found my $lnnum = 0; my ($isc,$ptxt,$ttxt,$ise,$atxt,$ctxt); my $incomm = 0; my ($inf_name,$inf_dir) = fileparse($inf); check_file_dir(\$inf_dir); my ($lbal,$ifil,$fnd,$add,$loc); if (open INF, "<$inf") { my @lines = <INF>; close INF; my ($nm, $dir) = fileparse( $inf ); my $lc = scalar @lines; prt( "\nGot $lc lines of [$inf] to process ...\n" ) if ($dbg8); my $msg = ''; my $rpt = 0; foreach my $line (@lines) { $lnnum++; chomp $line; $line = trim_all($line); if ($incomm) { ($ise,$atxt) = C_comment_ends($line); if ($ise) { $incomm = 0; $ctxt = trim_all($atxt); if (length($ctxt)) { $line = $ctxt; } else { next; } } else { next; } } ($isc,$ptxt,$ttxt) = C_comment_starts($line); if ($isc) { # C comment starting ... ($ise,$atxt) = C_comment_ends($ttxt); if ($ise) { $ptxt = trim_all($ptxt); $atxt = trim_all($atxt); $ctxt = $ptxt; $ctxt .= ' ' if (length($ctxt) && length($atxt) && ($atxt ne ';')); $ctxt .= $atxt if length($atxt); $ctxt = trim_all($ctxt); if (length($ctxt)) { $line = $ctxt; } else { next; } } else { $incomm = 1; $ptxt = trim_all($ptxt); if (length($ptxt)) { $line = $ptxt; } else { next; } } } else { ($isc,$ptxt) = inline_comment_starts($line); if ($isc) { $ctxt = trim_all($ptxt); if (length($ctxt)) { $line = $ctxt; } else { next; } } } if ($line =~ /^\s*#\s*include\s+(.+)\s*/) { $ic++; $lbal = $1; $ifil = ''; $loc = $I_NFD; if ($lbal =~ /<(.+)>/) { $ifil = $1; } elsif ($lbal =~ /"(.*)"/) { $ifil = $1; } if (length($ifil) == 0) { prtw( "WARNING: CHECK ME:$lnnum: line[$line] tail[$lbal] ... from [$inf]...\n" ); next; } $fnd = 0; my $ff = $dir; $ff .= "\\" if !(substr($dir,-1) =~ /(\\|\/)/); $ff .= $ifil; $inc_fils .= '*' if (length($inc_fils)); $inc_fils .= $ifil; # accumulate the file, '*' separated $msg = "FAILED"; $rpt = 0; prt( "Trying [$ff] LOCAL\n" ) if ($dbg7); if (-f $ff) { $msg = "OKL"; $loc = $I_LOC; $add = add_2_included( $ff, $inf, $I_LOC ); if ($add) { $msg .= " ADDED"; $addcnt++; process_file( $ff, ($lev + 1) ); } else { $msg .= " REPEAT"; $rpt = 1; } $fnd = 1; } else { # 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 = "OKR"; $loc = $I_REL; $add = add_2_included( $ff, $inf, $I_REL ); if ($add) { $msg .= " ADDED"; $addcnt++; process_file( $ff, ($lev + 1) ); } 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 = "OKS"; $loc = $I_SYS; $add = add_2_included( $ff, $inf, $I_SYS ); if ($add) { $msg .= " ADDED"; $addcnt++; process_file( $ff, ($lev + 1) ); } else { $msg .= " REPEAT"; $rpt = 1; } $fnd = 1; last; } } } } prt( "$addcnt:$ic $line - $ifil - [$ff] - $msg\n" ) if (!$rpt && $dbg9); my $tmp1 = sub_in_folder($inf); my $tmp2 = sub_in_folder($ff); #prtw( "WARNING: [$inf]:$lnnum: [$line] - [$ifil] - [$ff] - $msg\n" ) if (!$fnd && !is_excluded_inc($ifil)); prtw( "WARNING: [$tmp1]:$lnnum: [$line] - [$ifil] - [$tmp2] - $msg\n" ) if (!$fnd && !is_excluded_inc($ifil)); $inc_locs .= "*" if (length($inc_locs)); $inc_locs .= "$loc"; } # process an INCLUDE line } prt( "Found $ic in [$inf] ...\n" ) if ($dbg10); add_2_found_list( $inf, $ic, $inc_fils, $inc_locs ); } else { prtw( "ERROR: Failed to open file [$inf] ...\n" ); } } # put least first sub mycmp_ascend_asc { if (${$a}[0] lt ${$b}[0]) { prt( "-[".${$a}[0]."] lt [".${$b}[0]."]\n" ) if $verb3; return -1; } if (${$a}[0] gt ${$b}[0]) { prt( "+[".${$a}[0]."] gt [".${$b}[0]."]\n" ) if $verb3; return 1; } prt( "=[".${$a}[0]."] eq [".${$b}[0]."]\n" ) if $verb3; return 0; } sub mycmp_ascend { if (${$a}[0] < ${$b}[0]) { prt( "-[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3; return -1; } if (${$a}[0] > ${$b}[0]) { prt( "+[".${$a}[0]."] > [".${$b}[0]."]\n" ) if $verb3; return 1; } prt( "=[".${$a}[0]."] == [".${$b}[0]."]\n" ) if $verb3; return 0; } sub show_found_list { my @sfoundlst = sort mycmp_ascend @foundlst; my $cnt = scalar @sfoundlst; my $fc = 0; my ($f,$ff,$ic,$nm,$dir,$len,$min,$msg,$fs,$min2); my ($ll); $min = 0; $min2 = 75; prt( "\nOutput list of $cnt headers found starting with $fin_file ...\n" ); my %done = (); # 2010/04/25 - skip duplicate names my %done2 = (); for ($f = 0; $f < $cnt; $f++) { $ff = $sfoundlst[$f][1]; ($nm,$dir) = fileparse($ff); $len = length($nm); $min = $len if ($len > $min); } $min += 6; for ($f = 0; $f < $cnt; $f++) { $fs = $sfoundlst[$f][2]; $ff = $sfoundlst[$f][1]; $ic = $sfoundlst[$f][0]; $ll = $sfoundlst[$f][3]; $fc++; ($nm,$dir) = fileparse($ff); $msg = "$fc"; $msg = ' '.$msg while (length($msg) < 3); $msg .= ": $nm"; $msg .= ' ' while (length($msg) < $min); $msg .= "$ic "; $fs =~ s/\*/, /g; # file list - convert '*' separator to a comma+space $msg .= "[$fs]"; next if ($avoid_dup_headers && (defined $done{$ff})); $msg .= ' ' while (length($msg) < $min2); $ff = fix_rel($ff) if ( ($ff =~ /^\w:(\\|\/)/) && ($ff =~ /(\\|\/)\.\.(\\|\/)/) ); $ff = sub_in_folder($ff); $msg .= " [$ff]"; if (defined $done2{$nm}) { $msg .= " (RPT)"; } prt( "$msg\n" ); $done{$ff} = 1; $done2{$nm} = 1; } prt( "Done list of $cnt headers found starting with $fin_file ...\n" ); } sub show_by_folder() { $cicnt = scalar @included; prt( "\nGot TOTAL $cicnt includes from [$fin_file] ...\n" ); my ($i,$f,$ord); my ($nam, $dir); for ($i = 0; $i < $cicnt; $i++) { $f = $included[$i][0]; $ord = $included[$i][1]; if (-f $f) { prt( "[dbg_i21] $ord $f - ok\n" ) if ($dbg_i21); } else { prt( "$ord $f - NOT FOUND\n" ); } ($nam, $dir) = fileparse($f); $dir = fix_rel($dir) if (($dir =~ /^\w:(\\|\/)/)&&($dir =~ /(\\|\/)\.\.(\\|\/)/)); # $dir = fix_rel($dir) if ($dir =~ /^\w+:(\\|\/)/); $dir = sub_in_folder($dir); $dir = "<root>" if (length($dir) == 0); if (defined $byfolder{$dir}) { $byfolder{$dir} .= '*'.$nam; } else { $byfolder{$dir} = $nam; } } prt( "\nBY FOLDER - TOTAL $cicnt includes from [$fin_file] ...\n" ); foreach $dir (sort (keys(%byfolder))) { my $fnms = $byfolder{$dir}; my @nms = split(/\*/,$fnms); my @nmss = sort @nms; prt( "$dir - ".scalar @nms." headers ...\n" ); prt( "[dbg_i22] ".join(", ", @nmss)."\n" ) if ($dbg_i22); } } ### MAIN ### # ======== parse_args(@ARGV); prt( "Searching $fin_file...\n" ); ($fin_name, $fin_folder) = fileparse($fin_file); check_file_dir(\$fin_folder); @include_folders = get_INCLUDE_Folders($fin_folder); my $incfcnt = scalar @include_folders; prt( "Got $incfcnt INCLUDE folders ...\n" ); process_file($fin_file, 0); show_by_folder(); show_found_list(); pgm_exit(0,"Normal exit(0)"); ### END ### sub add_2_included($$$) { my ($fil,$in,$loc) = @_; 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++; # 1 2 3 4 5 push(@included, [$fil, $inccount, $in, $loc, 0]); return 1; } sub is_same_file { my ($f1, $f2) = @_; my $len = length($f1); if ($len != length($f2)) { return 0; # not the SAME } $f1 =~ s/\//\\/g; $f2 =~ s/\//\\/g; my $lcf1 = lc($f1); my $lcf2 = lc($f2); my $i = 0; while ($i < $len) { if (substr($lcf1,$i,1) ne substr($lcf2,$i,1)) { return 0; } $i++; } return 1; } sub C_comment_starts { my ($txt) = shift; my $len = length($txt); my $ptxt = ''; my $ttxt = ''; my ($k, $ch, $pch, $k2, $nch); for ($k = 0; $k < $len; $k++) { $k2 = $k + 1; $ch = substr($txt,$k,1); $nch = (($k2 < $len) ? substr($txt,$k2,1) : ''); if (($ch eq '/')&&($nch eq '*')) { $ttxt = substr($txt,($k2+1)); return $k2, $ptxt, $ttxt; # return offset, previous and begin comment } $pch = $ch; $ptxt .= $ch; } return 0, $ptxt, $ttxt; } sub inline_comment_starts { my ($txt) = shift; my $len = length($txt); my $ptxt = ''; my ($k, $ch, $pch, $k2, $nch); for ($k = 0; $k < $len; $k++) { $k2 = $k + 1; $ch = substr($txt,$k,1); $nch = (($k2 < $len) ? substr($txt,$k2,1) : ''); if (($ch eq '/')&&($nch eq '/')) { return $k2, $ptxt; # return offset, previous } $pch = $ch; $ptxt .= $ch; } return 0, $ptxt; } sub C_comment_ends { my ($txt) = shift; my $len = length($txt); my $ttxt = ''; my ($k, $ch, $pch, $k2, $nch); for ($k = 0; $k < $len; $k++) { $k2 = $k + 1; $ch = substr($txt,$k,1); $nch = (($k2 < $len) ? substr($txt,$k2,1) : ''); if (($ch eq '*')&&($nch eq '/')) { $ttxt = substr($txt,($k2+1)); return $k2, $ttxt; # return trailing } $pch = $ch; } return 0, $ttxt; } ##################################################################### 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 parse_args { my (@av) = @_; while (@av) { my $arg = $av[0]; if ($arg =~ /^-/) { my $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); my $ch = substr($sarg,0,1); if (($ch =~ /^h/i)||($ch eq '?')) { show_help(); pgm_exit(0,"Help exit(0)"); } elsif ($ch =~ /^l/i) { $load_log = 1; } elsif ($sarg =~ /^v/i) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/i) { $verbosity++; $sarg = substr($sarg,1); } } prt("Verbosity = $verbosity\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Unknown option [$arg]\n"); } } else { $fin_file = $arg; } shift @av; } if ($debug_on && (length($fin_file) == 0)) { if (length($def_file) && (-f $def_file)) { $fin_file = $def_file; prt("Using DEFAULT file [$fin_file]\n"); } else { pgm_exit(1,"ERROR: No input file found in command!\n"); } } if (length($fin_file) == 0) { pgm_exit(1,"ERROR: No input file found in command!\n"); } } # eof - inctrail02.pl