#!/perl -w # NAME: inctrail02.pl # AIM: Given an in C/C++ file, check for #include "file" and #include # statements, and follow the trail, listing ALL included files, included ... # 22/10/2015 - Add a find in all files processed # 07/07/2013 - More UI improvements # 07/08/2012 - Further UI improvements # 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 File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from use Cwd; my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; require 'getvcdirs.pl' or die "Unable to load 'getvcdirs.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 = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; open_log($outfile); # features my $VERS = "0.0.8 07/07/2013"; ##my $VERS = "0.0.7 07/02/2012"; my $show_rel_warnings = 0; my $avoid_dup_headers = 1; # only output each header ONCE my $load_log = 0; my $inc_system_files = 0; my $scan_system_includes = 0; my $root_dir = ''; my $keep_found_order = 1; my $do_folder_show = 0; my $out_file = ''; my $exclude_vcincs = 0; my $exclude_notfnd = 0; my $sort_found_incs = 0; my $find_me = ''; my %g_found_me = (); my @g_find_me = (); my @excluded_incs = qw( macwin32.h rpcmac.h ); my @excluded_bgns = qw( X11 ); my @include_dirs = (); my @g_found_incs = (); my %g_found_dupes = (); # 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 @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 my $I_ROOT = 4; # found using users root dir(s) # 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 scan_directories($$); sub scan_directories($$) { my ($dir,$rh) = @_; if (!opendir(DIR,$dir)) { prtw("WARNING: Failed to opedir $dir!\n"); return; } my @files = readdir(DIR); closedir(DIR); my ($ff,$file); if (!defined ${$rh}{$dir}) { ${$rh}{$dir} = 1; # add this one also } ut_fix_directory(\$dir); my @dirs = (); foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-d $ff) { if (!defined ${$rh}{$ff}) { ${$rh}{$ff} = 1; push(@dirs,$ff); } } } foreach $dir (@dirs) { scan_directories($dir,$rh); } } my @root_dirs = (); sub get_root_dirs() { return \@root_dirs if (@root_dirs); return \@root_dirs if (!length($root_dir)); my @arr = split(';',$root_dir); my %dirs = (); my ($dir,$cnt); foreach $dir (@arr) { prt("Scanning user root [$dir]\n") if (VERB5()); scan_directories( $dir, \%dirs ); } @root_dirs = keys %dirs; $cnt = scalar @root_dirs; prt("get_root_dirs: Returning $cnt directories, from scan of [$root_dir]\n"); if (VERB9()) { $cnt = 0; foreach $dir (@root_dirs) { $cnt++; prt("$cnt: $dir\n"); } prt("[v9] Listed $cnt dirs, from [$root_dir}\n"); } return \@root_dirs; } 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 strip_comment($) { my $line = shift; my $len = length($line); my $nline = ''; my ($i,$i2,$ch,$nc,$incom); $incom = 0; for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $ch = substr($line,$i,1); $nc = ($i2 < $len) ? substr($line,$i2,1) : ""; if ($incom) { if (($ch eq '*')&&($nc eq '/')) { $incom = 0; $i++; } } elsif (($ch eq '/')&&($nc eq '/')) { last; } elsif (($ch eq '/')&&($nc eq '*')) { $incom = 1; $i++; } else { $nline .= $ch; } } return trim_all($nline); } 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++; # 0 1 2 3 4 push(@included, [$fil, $inccount, $in, $loc, 0]); ###prt("Add to \@included $fil, $inccount, $in, $loc, 0\n"); 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 trim_comment_tail($) { my $txt = shift; my $len = length($txt); 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) : ''; if ((($ch eq '/')&&($nc eq '/'))|| (($ch eq '/')&&($nc eq '*'))) { # found a comment $txt = substr($txt,0,($i - 1)); $txt = trim_all($txt); last; } } return $txt; } sub add_to_global($$$$$) { my ($ifil,$inf,$loc,$found_file,$ri) = @_; if (defined $g_found_dupes{$ifil}) { $g_found_dupes{$ifil}++; } else { $g_found_dupes{$ifil} = 1; my @a = @{$ri}; push(@g_found_incs, [$ifil,$inf,$loc,$found_file,\@a]); } } sub path_per_os($) { my $path = shift; if ($os =~ /Win/i) { $path = path_u2d($path); } else { $path = path_d2u($path); } return $path; } sub process_file($$) { my ($inf,$lev) = @_; if (! open INF, "<$inf") { #pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); prtw("WARING: Unable to open file [$inf]\n"); } my @lines = ; close INF; my $lncnt = scalar @lines; my $ccnt = sprintf("%4d",$lncnt); prt("Processing $ccnt lines, from [$inf]...\n") if (VERB9()); my ($line,$inc,$lnn); $lnn = 0; my ($name,$dir) = fileparse($inf); ut_fix_directory(\$dir); my ($ff,$loc,$ifil,$len,$msg,$add,$rpt,$fnd,$chkd,$i,$ch,$pc,$incomment,$nline); my ($tmp); my @finc_files = (); my $found_file = ''; my @if_stack = (); $incomment = 0; foreach $line (@lines) { $lnn++; chomp $line; $line = trim_all($line); $len = length($line); next if ($len == 0); $nline = ''; $ch = ''; for ($i = 0; $i < $len; $i++) { $pc = $ch; $ch = substr($line,$i,1); if ($incomment) { if (($ch eq '/') && ($pc eq '*')) { $incomment = 0; } next; } else { if (($ch eq '*') && ($pc eq '/')) { $incomment = 1; next; } } $nline .= $ch; } $line = trim_all($nline); $len = length($line); next if ($len == 0); if (length($find_me)) { if ($line =~ /$find_me/) { if (!defined $g_found_me{$inf}) { $g_found_me{$inf} = $lnn; push(@g_find_me,[$lnn,$inf]); } } } $found_file = ''; if ($line =~ /\s*#\s*include\s+(.+)$/) { $inc = trim_comment_tail($1); prt("$lnn: $inc\n") if (VERB9()); $loc = $I_NFD; $ifil = ''; if ($inc =~ /<(.+)>/) { $ifil = path_per_os($1); } elsif ($inc =~ /"(.+)"/) { $ifil = path_per_os($1); } elsif ($inc =~ /^\w+$/) { prtw( "WARNING:$lnn: inc $inc is var, line[$line]... from [$inf]...\n" ); next; } else { prtw( "WARNING: CHECK ME:$lnn: line[$line]... from [$inf]...\n" ); next; } prt("$lnn: [$ifil]\n") if (VERB9()); $msg = "NF"; $ff = $dir.$ifil; $chkd = "$ff\n"; $fnd = 0; if (-f $ff) { $found_file = $ff; $loc = $I_LOC; $msg = 'ok '; $add = add_2_included( $ff, $inf, $loc ); add_to_global($ifil,$inf,$loc,$found_file,\@if_stack); if ($add) { $msg .= " ADDED"; $addcnt++; push(@finc_files,$ff); if ($keep_found_order) { # to keep ORDER, process NOW on found process_file($ff,$lev+1); } } else { $msg .= " REPEAT"; $rpt = 1; } $fnd = 1; } if (!$fnd) { foreach $tmp (@include_dirs) { # ut_fix_directory(\$tmp); $ff = $tmp.$ifil; $chkd .= "$ff\n"; if (-f $ff) { $found_file = $ff; $loc = $I_REL; $msg = 'ok '; $add = add_2_included( $ff, $inf, $loc ); add_to_global($ifil,$inf,$loc,$found_file,\@if_stack); if ($add) { $msg .= " ADDED"; $addcnt++; push(@finc_files,$ff); if ($keep_found_order) { # to keep ORDER, process NOW on found process_file($ff,$lev+1); } } else { $msg .= " REPEAT"; $rpt = 1; } $fnd = 1; last; } } } if (!$fnd) { foreach $tmp (@include_folders) { ut_fix_directory(\$tmp); $ff = $tmp.$ifil; $chkd .= "$ff\n"; ###prt("Checking [$ff]\n"); if (-f $ff) { $found_file = $ff; $loc = $I_SYS; $msg = 'ok '; add_to_global($ifil,$inf,$loc,$found_file,\@if_stack); $add = add_2_included( $ff, $inf, $loc ); if ($add) { $msg .= " ADDED"; $addcnt++; if ($scan_system_includes) { push(@finc_files,$ff); if ($keep_found_order) { # to keep ORDER, process NOW on found process_file($ff,$lev+1); } } } else { $msg .= " REPEAT"; $rpt = 1; } $fnd = 1; last; } } } # 20130707 - add user root directories if ( !$fnd && length($root_dir) ) { my $ra = get_root_dirs(); foreach $tmp (@{$ra}) { ut_fix_directory(\$tmp); $ff = $tmp.$ifil; $chkd .= "$ff\n"; if (-f $ff) { $found_file = $ff; $loc = $I_ROOT; $msg = 'ok '; add_to_global($ifil,$inf,$loc,$found_file,\@if_stack); $add = add_2_included( $ff, $inf, $loc ); if ($add) { $msg .= " ADDED"; $addcnt++; push(@finc_files,$ff); if ($keep_found_order) { # to keep ORDER, process NOW on found process_file($ff,$lev+1); } } else { $msg .= " REPEAT"; $rpt = 1; } $fnd = 1; last; } } } if (!$fnd) { $ff = ''; $loc = $I_NFD; $msg = 'NOT FOUND '; $add = add_2_included( $ifil, $inf, $loc ); if ($add) { $msg .= " ADDED"; $addcnt++; ##### NOT FOUND push(@inc_files,$ff); } else { $msg .= " REPEAT"; $rpt = 1; } prt("Checked\n$chkd") if (VERB9()); add_to_global($ifil, $inf, $loc, $found_file, \@if_stack); } prt("$lnn: [$ifil] $msg\n") if (VERB9() || (VERB2() && !($msg =~ /REPEAT/))); if (defined $g_found_dupes{$ifil}) { $g_found_dupes{$ifil}++; } else { $g_found_dupes{$ifil} = 1; push(@g_found_incs, [$ifil, $inf, $loc, $found_file]); } } elsif ($line =~ /^\s*\#\s*if/) { # #if A # #ifdef A # ifndef A $msg = "$lnn: $line"; push(@if_stack,$msg); prt("$msg\n") if (VERB9()); } elsif ($line =~ /^\s*\#\s*endif/) { if (@if_stack) { $msg = pop(@if_stack); prt("$lnn: endif $msg\n") if (VERB9()); } else { prtw("$lnn: $line but no IF on stack\n"); } } } # now process the found include if (!$keep_found_order) { foreach $line (@finc_files) { process_file($line,$lev+1); } } } # 495. 515. 539. # 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( "\nFound TOTAL $cicnt includes from [$fin_file] ...\n" ); my ($i,$f,$ord,$tmp,$loc,$cnt,$msg); my ($nam, $dir,$ra); my %locs = (); for ($i = 0; $i < $cicnt; $i++) { # 0 1 2 3 4 # push(@included, [$fil, $inccount, $in, $loc, 0]); $f = $included[$i][0]; $ord = $included[$i][1]; $loc = $included[$i][3]; $locs{$loc}++; if (-f $f) { prt( "[dbg_i21] $ord $f - ok\n" ) if ($dbg_i21); } else { prt( "$ord $f - NOT FOUND\n" ) if ($loc != $I_NFD); # only show if NOT already known tonot be found } ($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 = "" if (length($dir) == 0); if ($inc_system_files || (($loc == $I_LOC)||($loc == $I_REL))) { $byfolder{$dir} = [] if (!defined $byfolder{$dir}); $ra = $byfolder{$dir}; push(@{$ra},[$nam,$loc]); } } $msg = "By location: "; foreach $loc (sort keys %locs) { $msg .= "$loc=".$locs{$loc}." "; } prt("$msg\n"); prt( "BY FOLDER - TOTAL $cicnt includes from [$fin_file] ...\n" ); my $cmake = "set(name_INCS\n"; foreach $dir (sort (keys(%byfolder))) { $ra = $byfolder{$dir}; $cnt = scalar @{$ra}; prt( "$dir - $cnt headers ...\n" ); prt( "[dbg_i22] ".join(", ", @{$ra})."\n" ) if ($dbg_i22); for ($i = 0; $i < $cnt; $i++) { $tmp = ${$ra}[$i][0]; $loc = ${$ra}[$i][1]; $cmake .= " ".path_d2u($dir.$tmp)."\n"; ###$cmake .= " ".path_d2u($dir.$tmp)." # $loc\n"; } } $cmake =~ s/\n$//; $cmake .= " )\n"; prt($cmake); } sub get_inc_folders() { @include_folders = get_INCLUDE_Folders($fin_folder); my $incfcnt = scalar @include_folders; prt( "Got $incfcnt INCLUDE folders ...\n" ) if (VERB5()); if (VERB2()) { my ($tmp,$ok); foreach $tmp (@include_folders) { $ok = (-d $tmp) ? "ok" : "NOT VALID"; prt(" $tmp $ok\n"); } } } my %location = ( $I_NFD => "NOT found ", $I_LOC => "locally ", $I_REL => "relative ", $I_SYS => "VC includes", $I_ROOT => "Usr Root " ); sub list_found_incs() { @g_found_incs = sort mycmp_ascend_asc(@g_found_incs) if ($sort_found_incs); my $cnt = scalar @g_found_incs; prt("Found $cnt include files from [$fin_file] start...\n"); my ($i,$ifil,$inf,$loc,$ltxt,$min,$len,$msg,$ff,$done); my $ofl = length($out_file); $min = 0; $msg = ''; for ($i = 0; $i < $cnt; $i++) { # 0 1 2 # push(@g_found_incs, [$ifil, $inf, $loc]); $ifil = $g_found_incs[$i][0]; $len = length($ifil); $min = $len if ($len > $min); } $done = 0; for ($i = 0; $i < $cnt; $i++) { # 0 1 2 3 4 # push(@g_found_incs, [$ifil, $inf, $loc, $found_file, \@ia]); $ifil = $g_found_incs[$i][0]; $inf = $g_found_incs[$i][1]; $loc = $g_found_incs[$i][2]; $ff = $g_found_incs[$i][3]; $ltxt = $location{$loc}; next if ($exclude_vcincs && ($loc == $I_SYS)); next if ($exclude_notfnd && ($loc == $I_NFD)); if ($loc == $I_NFD) { $msg .= "$ltxt $ifil\n"; } else { $msg .= "$ff\n"; } $ifil .= ' ' while (length($ifil) < $min); prt("$ifil $ltxt from $inf\n"); if (VERB5()) { my $ria = $g_found_incs[$i][4]; if (@{$ria}) { $ltxt = ${$ria}[-1]; prt("Last #IF: $ltxt\n"); } } $done++; } prt("Listed $done of $cnt includes from [$fin_file] start...\n"); if (length($out_file)) { write2file($msg,$out_file); prt("List of include files written to $out_file\n"); } } sub show_found_me() { if (length($find_me)) { my $cnt = scalar @g_find_me; my ($lnn,$inf,$ra); prt("Found '$find_me' in $cnt files...\n"); foreach $ra (@g_find_me) { $lnn = ${$ra}[0]; $inf = ${$ra}[1]; prt("$inf $lnn\n"); } } } ### MAIN ### # ======== ################################################################## parse_args(@ARGV); prt( "Scanning $fin_file for includes...\n" ); ($fin_name, $fin_folder) = fileparse($fin_file); check_file_dir(\$fin_folder); get_inc_folders(); process_file($fin_file, 0); show_by_folder() if ($do_folder_show); list_found_incs(); show_found_me(); ## show_found_list(); pgm_exit(0,""); ################################################################# ### END ### 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 need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av); } sub add_include_dirs($) { my $list = shift; my @arr = split(";",$list); my ($dir); foreach $dir (@arr) { ut_fix_directory(\$dir); push(@include_dirs,$dir); prt("Added directory [$dir]\n") if (VERB1()); } } 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) { if ($sarg =~ /^ll/) { $load_log = 2; } else { $load_log = 1; } } elsif ($sarg =~ /^v/i) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/i) { $verbosity++; $sarg = substr($sarg,1); } } prt("Set Verbosity = $verbosity\n") if (VERB1()); } elsif ($sarg =~ /^i/) { need_arg(@av); shift @av; $sarg = $av[0]; if (-d $sarg) { prt("Adding include directory [$sarg]\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Can NOT locate directory [$sarg]\n"); } add_include_dirs($sarg); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_file = $sarg; prt("Output list to $out_file\n") if (VERB1()); } elsif ($sarg =~ /^r/) { need_arg(@av); shift @av; $sarg = File::Spec->rel2abs($av[0]); if (-d $sarg) { prt("Adding root directory [$sarg]\n") if (VERB1()); $root_dir .= ';' if (length($root_dir)); $root_dir .= $sarg; } else { pgm_exit(1,"ERROR: Can NOT locate root [$sarg]\n"); } } elsif ($sarg =~ /^f/) { need_arg(@av); shift @av; $find_me = $av[0]; prt("Set to find '$find_me' in all files processed.\n") if (VERB1()); } elsif ($sarg =~ /^x/) { $exclude_vcincs = 1; prt("Set to exclude VC includes from final list.\n") if (VERB1()); } elsif ($sarg =~ /^n/) { $exclude_notfnd = 1; prt("Set to NOT found from final list.\n") if (VERB1()); } elsif ($sarg =~ /^s/) { $sort_found_incs = 1; prt("Set to NOT found from final list.\n") if (VERB1()); } else { pgm_exit(1,"ERROR: Unknown option [$arg]\n"); } } else { $fin_file = File::Spec->rel2abs($arg); if (! -f $fin_file) { pgm_exit(1,"ERROR: Can NOT locate file [$fin_file]!\n"); } } 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"); } } sub show_help { prt("$pgmname: version $VERS\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n"); prt(" --inc (-o) = Write found list to outut file\n"); prt(" --root (-r) = Search for include files recursively from this root\n"); prt(" --xlcude (-x) = Exclude VC Includes from final listing.\n"); prt(" --not (-n) = Exclude NOT found includes from final list.\n"); prt(" --find (-f) = Ginf this 'word' in all files processed.\n"); prt(" --sort (-s) = Sort the found list.\n"); } # eof - inctrail02.pl