listincs.pl to HTML.

index -|- end

Generated: Mon Aug 29 19:34:46 2016 from listincs.pl 2015/04/13 14.3 KB. text copy

#!/usr/bin/perl -w
# NAME: listincs.pl
# AIM: Given a C/C++ file, skip comments, and list the 'include' files found
# 13/04/2015 - Allow an input directory, and scan all 'c' and 'h' files found
# 27/10/2013 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
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";
# 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);

# user variables
my $VERS = "0.0.1 2013-10-27";
my $load_log = 0;
my $in_file = '';
my @in_files = ();
my $verbosity = 0;
my $out_file = '';
my $src_dir = '';
my $recursive = 1;

# ### DEBUG ###
my $debug_on = 0;
my $def_src  = 'F:\FG\18\openssl';
my $def_file = 'F:\FG\18\openssl\crypto\o_dir.c';

### program variables
my @warnings = ();
my $cwd = cwd();
my %doneincs = ();
my %included = ();
my %shown = ();

my %sys_files = (
    'errno.h' => 1,
    'unistd.h' => 1,
    'sys/stat.h' => 1,
    'sys/socket.h' => 1,
    'tcp.h' => 1,
    'netdb.h' => 1,
    'winsock2.h' => 1,
    'ws2tcpip.h' => 1,
    'windows.h' => 1,
    'stdio.h' => 1,
    'stddef.h' => 1,
    'string.h' => 1,
    'malloc.h' => 1,
    'io.h' => 1,
    'fcntl.h' => 1,
    'stdlib.h' => 1,
    'unixlib.h' => 1,
    'screen.h' => 1,
    'sys/types.h' => 1,
    'winsock.h' => 1,
    'netinet/in.h' => 1,
    'sys/time.h' => 1,
    'sys/bsdskt.h' => 1,
    'sys/select.h' => 1,
    'novsock2.h' => 1,
    'sys/param.h' => 1,
    'time.h' => 1,
    'socket.h' => 1,
    'in.h' => 1,
    'inet.h' => 1,
    'sys/filio.h' => 1,
    'arpa/inet.h' => 1,
    'sys/fcntl.h' => 1,
    'sys/ioctl.h' => 1,
    'unixio.h' => 1,
    'socketshr.h' => 1,
    'limits.h' => 1,
    'dirent.h' => 1,
    'libfildef.h' => 1,
    'lib$routines.h' => 1,
    'strdef.h' => 1,
    'str$routines.h' => 1,
    'stsdef.h' => 1,
    'tchar.h' => 1
    );

#36: LPdir.h loc hdr NF 0
#32: descrip.h sys hdr NF 0
#33: namdef.h sys hdr NF 0
#34: rmsdef.h sys hdr NF 0


my %specials = (
    'ioLib.h' => 1,
    'tickLib.h' => 1,
    'sysLib.h' => 1,
    'vxWorks.h' => 1,
    'sockLib.h' => 1,
    'taskLib.h' => 1,
    'OS.h' => 1
    );

sub in_sys_includes($$) {
    my ($inc,$finc) = @_;
    return 1 if (defined $sys_files{$inc});
    return 1 if (defined $sys_files{$finc});
    return 1 if (defined $specials{$inc});
    return 1 if (defined $specials{$finc});
    $inc = lc($inc);
    $finc = lc($finc);
    return 1 if (defined $sys_files{$inc});
    return 1 if (defined $sys_files{$finc});
    return 0;
}

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

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        prt( "\nNo warnings issued.\n\n" ) if (VERB9());
    }
}

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


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

my $done_scan = 0;
my $dirs_found = 0;
my $files_found = 0;
my %dir_scan = ();
sub scan_directory($$);
sub scan_directory($$) {
    my ($dir,$lev) = @_;
    if (! opendir(DIR,$dir) ) {
        prtw("WARNING: Failed to open directory $dir!\n");
        return; # nothing to do but return
    }
    my @files = readdir(DIR);
    closedir(DIR);
    my ($file,$ff,$ra);
    ut_fix_directory(\$dir);
    my @dirs = ();
    $dirs_found++;
    foreach $file (@files) {
        next if ($file eq '.');
        next if ($file eq '..');
        $ff = $dir.$file;
        if (-d $ff) {
            push(@dirs,$ff);
        } elsif (-f $ff) {
            # keep everything, or just likely sources - no EVERYTHING
            # keep as hash or array - choose array, since can push full and file name
            # but a hash on file name with an array of locations seems best
            $dir_scan{$file} = [] if (!defined $dir_scan{$file});
            $ra = $dir_scan{$file};
            push(@{$ra},$dir);   # this file was found in this array of directories
            $files_found++;
        } else {
            pgm_exit(1,"ERROR: WHAT IS THIS [$ff] if not file or folder!!! FIX ME!!!\n");
        }
    }
    foreach $ff (@dirs) {
        scan_directory($ff,($lev+1));
    }
    if ($lev == 0) {
        prt("In scan of $dirs_found Directories, found $files_found files...\n");
    }
}


sub scan_base() {
    $done_scan = 1;
    scan_directory($src_dir,0);
}

sub process_in_file($);

sub process_in_file($) {
    my ($inf) = @_;
    if (! open INF, "<$inf") {
        pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); 
    }
    my @lines = <INF>;
    close INF;
    my $lncnt = scalar @lines;
    scan_base() if (length($src_dir) && !$done_scan);
    my $hdr = "Processing $lncnt lines, from [$inf]...";
    my ($line,$inc,$lnn,$incomm,$tline,$len,$i,$ch,$pc,$nc,$i2,$nline,$rda,$typ,$sys,$ff,$dc);
    my ($finc,$tmp,@arr,$show);
    $lnn = 0;
    $incomm = 0;
    $ch = '';
    my @incs = ();
    foreach $line (@lines) {
        chomp $line;
        $tline = trim_all($line);
        $lnn++;
        $len = length($tline);
        next if ($len == 0);
        $nline = '';
        for ($i = 0; $i < $len; $i++) {
            $pc = $ch;
            $i2 = $i + 1;
            $ch = substr($tline,$i,1);
            $nc = ($i2 < $len) ? substr($tline,$i2,1) : '';
            if ($incomm) {
                if (($ch eq '/')&&($pc eq '*')) {
                    $incomm = 0;
                }
                next;
            }
            # not in a comment
            if (($ch eq '/') && ($nc eq '*')) {
                # start comment
                $incomm = 1;
                next;
            }
            if (($ch eq '/') && ($nc eq '/')) {
                last;
            }
            $nline .= $ch;
        }
        if ($nline =~ /^\s*#\s*include\s+(.+)$/) {
            $inc = trim_all($1);
            $typ = 'unk';
            $sys = 'unk';
            $dc  = 0;
            if ($inc =~ /^"/) {
                $inc = substr($inc,1);
                $inc =~ s/"$//;
                $sys = 'loc';
            } elsif ($inc =~ /^</) {
                $inc = substr($inc,1);
                $inc =~ s/>$//;
                $sys = 'sys'
            }
            if (is_h_source($inc)) {
                $typ = 'hdr';
            } elsif (is_c_source($inc)) {
                $typ = 'src';
            }
            $finc = $inc;
            if ($done_scan) {
                if (defined $dir_scan{$inc}) {
                    $rda = $dir_scan{$inc};
                    $ch = ${$rda}[0];
                    $ff = $ch.$inc;
                    if (-f $ff) {
                        if (!defined $doneincs{$ff}) {
                            $doneincs{$ff} = 1;
                            push(@incs,$ff);
                        }
                    } else {
                        prtw("WARNING: File NOT found [$ff]\n");
                    }
                } else {
                    if ($inc =~ /\//) {
                        @arr = split(/\//,$inc);
                        $dc = scalar @arr - 1;
                        $tmp = $arr[-1];
                        if (defined $dir_scan{$tmp}) {
                            $rda = $dir_scan{$tmp};
                            $ch = ${$rda}[0];
                            $ff = $ch.$tmp;
                            if (-f $ff) {
                                $inc = $tmp;
                                if (!defined $doneincs{$ff}) {
                                    $doneincs{$ff} = 1;
                                    push(@incs,$ff);
                                }
                            } else {
                                prtw("WARNING: File NOT found [$ff]\n");
                            }
                        } else {
                            $ch = 'Nf';
                        }
                    } else {
                        $ch = 'NF';
                    }
                }
            } else {
                $ch = 'NS';
            }
            $ff = $ch.$inc;
            if (!defined $shown{$ff}) {
                $shown{$ff} = 1;
                $show = 1;
                if ($ch =~ /^N(f|F|S)$/) {
                    $show = 0 if ( in_sys_includes($inc,$finc) );
                }
                if ($show) {
                    prt("$hdr\n") if (length($hdr));
                    $hdr = '';
                    prt("$lnn: $inc $sys $typ $ch $dc\n");
                }
            }
            $included{$inc} = [] if (!defined $included{$inc});
            $rda = $included{$inc};
            push(@{$rda}, [$lnn, $inf, $sys, $typ, $ch, $dc]);
        }
        #if ($nline =~ /^\s*#\s*include\s+(<|")(.+)(<|")/) {
        #    $inc = $2;
        #    prt("$lnn: $inc\n");
        #}
    }
    if ($recursive) {
        foreach $inf (@incs) {
            process_in_file($inf);
        }
    }
}

sub process_in_files() {
    foreach $in_file (@in_files) {
        process_in_file($in_file);
    }
}

#########################################
### MAIN ###
parse_args(@ARGV);
##process_in_file($in_file);
process_in_files();
pgm_exit(0,"");
########################################

sub scan_dir($$) {
    my ($dir,$rin) = @_;
    if (! opendir(DIR,$dir) ) {
        prtw("WARNING: Failed to open directory $dir!\n");
        return; # nothing to do but return
    }
    my @files = readdir(DIR);
    closedir(DIR);
    my ($file,$ff,$ra);
    ut_fix_directory(\$dir);
    my @dirs = ();
    $dirs_found++;
    foreach $file (@files) {
        next if ($file eq '.');
        next if ($file eq '..');
        $ff = $dir.$file;
        if (-d $ff) {
            push(@dirs,$ff);
        } elsif (-f $ff) {
            if (is_c_source($file) || is_h_source($file)) {
                ${$rin} = $ff;
                push(@in_files,$ff);
            }
        }
    }
}


sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av);
}

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 =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^v/) {
                if ($sarg =~ /^v.*(\d+)$/) {
                    $verbosity = $1;
                } else {
                    while ($sarg =~ /^v/) {
                        $verbosity++;
                        $sarg = substr($sarg,1);
                    }
                }
                prt("Verbosity = $verbosity\n") if (VERB1());
            } elsif ($sarg =~ /^l/) {
                if ($sarg =~ /^ll/) {
                    $load_log = 2;
                } else {
                    $load_log = 1;
                }
                prt("Set to load log at end. ($load_log)\n") if (VERB1());
            } elsif ($sarg =~ /^o/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $out_file = $sarg;
                prt("Set out file to [$out_file].\n") if (VERB1());
            } elsif ($sarg =~ /^b/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $src_dir = $sarg;
                if (! -d $src_dir) {
                    pgm_exit(1,"ERROR: Base directory $src_dir does NOT exist!\n");
                }
                prt("Set src directory to [$src_dir].\n") if (VERB1());
            } elsif ($sarg =~ /^c/) {
                $src_dir = $cwd;
                if (! -d $src_dir) {
                    pgm_exit(1,"ERROR: Base directory $src_dir does NOT exist!\n");
                }
                prt("Set base src directory to [$src_dir].\n") if (VERB1());
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            if (-d $arg) {
                scan_dir($arg,\$in_file);
            } elsif (-f $arg) {
                $in_file = $arg;
                prt("Set input to [$in_file]\n") if (VERB1());
                push(@in_files,$arg);
            }
        }
        shift @av;
    }

    if ($debug_on) {
        prtw("WARNING: DEBUG is ON!\n");
        if (length($in_file) ==  0) {
            $in_file = $def_file;
            prt("Set DEFAULT input to [$in_file]\n");
        }
        if (length($src_dir) == 0) {
            $src_dir = $def_src;
        }
        $load_log = 1;
    }
    if (length($in_file) ==  0) {
        pgm_exit(1,"ERROR: No input files found in command!\n");
    }
    if (! -f $in_file) {
        pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n");
    }
}

sub give_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(" --load        (-l) = Load LOG at end. ($outfile)\n");
    prt(" --out <file>  (-o) = Write output to this file.\n");
    prt(" --base <dir>  (-b) = Set base directory to scan finding includes.\n");
    prt(" --cwd         (-c) = Set base directory to current work directory.\n");
}

# eof - template.pl

index -|- top