inctrail02.pl to HTML.

index -|- end

Generated: Mon Aug 29 19:34:42 2016 from inctrail02.pl 2015/10/22 34.8 KB. text copy

#!/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 ...
# 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 = <INF>;
    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 = "<root>" 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 <dir[;d] (-i) = Additional include directories.\n");
    prt(" --load         (-l) = Load LOG at end. ($outfile)\n");
    prt(" --out <file>   (-o) = Write found list to outut file\n");
    prt(" --root <dir>   (-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 <word>  (-f) = Ginf this 'word' in all files processed.\n");
    prt(" --sort         (-s) = Sort the found list.\n");

}

# eof - inctrail02.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional