chkifdef.pl to HTML.

index -|- end

Generated: Sat Oct 24 16:35:11 2020 from chkifdef.pl 2018/02/24 20.1 KB. text copy

#!/perl -w
# NAME: chkifdef.pl
# AIM: Scan a file or a directory, and check all files for #ifdef ????, and list them...
# 22/09/2015 - Simplify output
# 04/08/2013 - Output if stack count for each line output
# 30/05/2012 - Update UI
# 2009/09/17 - 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 RELATIVE
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 = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $VERS = "0.0.6 2015-09-22";
##my $VERS = "0.0.5 2015-03-11";
##my $VERS = "0.0.4 2013-08-04";
##my $VERS = "0.0.3 2012-05-30";
my $in_dir = '';
my $in_file = '';
my @in_dirs = ();
my @in_files = ();
my $verbosity = 0;
my $def_indent = '    ';
my $load_log = 0;
my $indent_hash = 0;
my $do_all_files = 0;
my $show_all_dupes = 0;
my $show_all_files = 0;
my %find_defs = ();
my $find_count = 0;
my %exclude_dirs = ( 
    '.git' => 1,
    'CVS' => 1,
    '.svn' => 1,
    '.hg' => 1
    );

my %exclude_files = ( '.gitignore' => 1 );
my $total_lines = 0;
my $total_files = 0;
my $total_ifdef = 0;
my $excluded_file = 0;
my $max_max = 30;
my $out_file = '';

my @files_list = ();

sub process_dir($$$$);

# DEBUG
my $dbg01 = 0;  # show my $msg = sprintf("Doing %4d items, from [$sdir]", $cnt); prt( "[dbg01] $msg... " ) if ($dbg01);
my $dbg02 = 0;  # prt( "[dbg02] Got $cnt files, and $dcnt folders...\n" ) if ($dbg02);
my $dbg03 = 0;  # $msg = sprintf( "Doing %5d lines, from [$sfn]...", $cnt ); prt( "[dbg03] $msg\n" ) if ($dbg03);
my $dbg04 = 0;  # simple define - if ($ival =~ /\w+/) { prt( "Line:$lnn: #if".$ityp." [$ival]\n" ) if ($dbg04);

my $debug_on = 0;
my $def_in_dir = 'C:\Projects\hb\liboil';

### program variables
my @warnings = ();
my $cwd = cwd();

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);
}


sub sub_root_name($) {
    my ($fil) = shift;
    $fil = substr($fil,length($in_dir));
    $fil =~ s/^(\\|\/)//;
    return $fil;
}

sub process_dir($$$$) {
    my ($dir,$rxd,$rxf,$rfl) = @_;
    opendir(DIR, $dir) || mydie("Couldn't open directory [$dir]\n");
    my @files = readdir(DIR);
    closedir(DIR);
    my $cnt = scalar @files;
    my $dcnt = 0;
    my @dirs = ();
    my $sdir = sub_root_name($dir);
    my $msg = sprintf("Doing %4d items, from [$sdir]", $cnt);
    prt( "[v9] $msg... " ) if ($dbg01 || VERB9());
    $dir .= "\\" if (!($dir =~ /(\\|\/)$/));
    $cnt = 0;
    my $added = 0;
    foreach my $file (@files) {
        next if (($file eq '.')||($file eq '..'));
        next if (defined ${$rxd}{$file});
        next if (defined ${$rxf}{$file});
        my $ff = $dir.$file;
        if (-d $ff) {
            # prt( "DIR: [$ff]\n" );
            push(@dirs,$ff);
            $dcnt++;
        } else {
            # prt( "FIL: [$ff]\n" );
            if ($do_all_files || is_c_source($file) || is_h_source($file)) {
                push(@{$rfl},$ff);
                $added++;
            } else {
                $excluded_file++;
            }
            $cnt++;
        }
    }
    prt( "[dbg02] Got $cnt files, and $dcnt folders...\n" ) if ($dbg02);
    foreach $dir (@dirs) {
        process_dir( $dir, $rxd, $rxf, $rfl );
    }
}

sub trim_comments_from_line($) {
    my ($txt) = shift;
    my ($len,$j,$cc,$pc,$nc,$ntxt);
    $ntxt = '';
    $len = length($txt);
    $cc = '';
    for ($j = 0; $j < $len; $j++) {
        $pc = $cc;
        $cc = substr($txt,$j,1);
        $nc = (($j + 1) < $len) ? substr($txt,$j+1,1) : '';
        # skip /* ... */
        if (($cc eq '/')&&($nc eq '*')) {
            # begin comment
            $j += 2;
            $cc = $nc;
            for (; $j < $len; $j++) {
                $pc = $cc;
                $cc = substr($txt,$j,1);
                last if (($cc eq '/')&&($pc eq '*'));
            }
            next;
        } elsif (($cc eq '/')&&($nc eq '/')) {
            last;
        }
        $ntxt .= $cc;
    }

    return $ntxt;
}

sub add_2_hash($$$) {
    my ($rh, $ival, $sfn) = @_;
    $ival = trim_all($ival);
    if (defined ${$rh}{$ival}) {
        ${$rh}{$ival} .= "|$sfn";
    } else {
        ${$rh}{$ival} = "$sfn";
    }
}

# lines like
# #if !(defined(_POSIX_MONOTONIC_CLOCK) && _POSIX_MONOTONIC_CLOCK >= 0 && defined(CLOCK_MONOTONIC))
sub parse_defines_in_line($) {
    my ($ival) = @_;
    my ($len,$j,$c,$tag,$hadd);
    $len = length($ival);
    my @a = ();
    $tag = '';
    for ($j = 0; $j < $len; $j++) {
        $c = substr($ival,$j,1);
        if ($c =~ /\w/) {
            $tag .= $c;
        } else {
            if (length($tag)) {
                if ($tag eq 'defined') {
                    $hadd = 1;
                    if ($c ne '(') {
                        $j++;
                        for (; $j < $len; $j++) {
                            $c = substr($ival,$j,1);
                            last if ($c eq '(');        # found the openning '('
                            last if (!($c =~ /\s/));    # but also abort on NOT space
                        }
                    }
                    if ($c eq '(') {
                        $tag = '';
                        $j++;
                        for (; $j < $len; $j++) {
                            $c = substr($ival,$j,1);
                            last if ($c eq ')');
                            $tag .= $c;
                        }
                        if (($c eq ')')&&(length($tag))) {
                            push(@a,trim_all($tag));
                        }
                    }
                }
            }
            $tag = '';
        }
    }
    return @a;
}

sub process_files($) {
    my ($rfl) = shift;
    my $cnt = scalar @{$rfl};
    my ($msg, $ityp, $ival, $lnn, $clnn, $tail, $scnt, $ind, $ra, $hash, $ifcnt);
    my ($sfn,$dir,$form,$ff,$i,$l,$l2,$nxln,$line);
    prt( "Processing $cnt files...\n" );
    my %hash = ();
    my $indent = $def_indent;
    my @ifstack = ();
    my $show = VERB5();
    foreach $ff (@{$rfl}) {
        $total_files++;
        ($sfn,$dir) = fileparse($ff);
        ###my $sfn = sub_root_name($ff);
        if (! open INF, "<$ff") {
            prtw( "WARNING: FAILED TO OPEN FILE [$ff]!\n" );
            next;
        }
        my @lines = <INF>;
        close INF;
        my $lncnt = scalar @lines;
        $total_lines += $lncnt;
        $form = sprintf("%d",length($lncnt));
        $form = '%'.$form.'d';
        if ($show) {
            prt("\n");
            prt("[v5] Doing $lncnt lines, from [$sfn]...\n");
        }
        $lnn = 0;
        $ind = '';
        my $ifdefcnt = 0;
        for ($l = 0; $l < $lncnt; $l++) {
            $line = $lines[$l];
            $l2 = $l + 1;
            $lnn = $l + 1;
            $clnn = sprintf($form,$lnn);
            chomp $line;
            $scnt = scalar @ifstack;
            $ifcnt = $scnt;
            if ($line =~ /^\s*\#\s*if(\w*)\s+(.+)$/) {
                $ityp = $1;
                $ival = trim_comments_from_line($2);
                $ind = $indent x $scnt;
                if ($indent_hash) {
                    $hash = $ind.'#';
                } else {
                    $hash = '#'.$ind;
                }
                if (length($ityp) == 0) {
                    # just an #if VALUE
                    if ($ival =~ /^\d+$/) {
                        # just a number define
                        prt( "$ifcnt: Line:$clnn:d: ${hash}if $ival\n" ) if ($show);
                    } else {
                        prt( "$ifcnt: Line:$clnn:0: ${hash}if $ival\n" ) if ($show);
                        my @defs = parse_defines_in_line($ival);
                        foreach $ityp (@defs) {
                            add_2_hash(\%hash, $ityp, $sfn);
                            $ifdefcnt++;
                        }
                    }
                } else {
                    if (($ifdefcnt == 0) && ($l2 < $lncnt)) {
                        $nxln = $lines[$l2];
                        if ($nxln =~ /^\s*\#\s*define\s+(.+)$/) {
                            $ifdefcnt++;
                            prt("Chk skipped '$line'\nfollowed by '$nxln'\n") if (VERB9());
                            $l++;
                            push(@ifstack,[$ityp,$ival,$lnn]);
                            next;
                        }
                    }
                    if ($ival =~ /\w+/) {
                        prt( "$ifcnt: Line:$clnn:w: ${hash}if".$ityp." $ival\n" ) if ($show);
                    } elsif ($ival =~ /^\d+$/) {
                        prt( "$ifcnt: Line:$clnn:d: ${hash}if".$ityp." $ival\n" ) if ($show);
                    } else {
                        prt( "$ifcnt: Line:$clnn:m: ${hash}if".$ityp." $ival\n" ) if ($show);
                    }
                    add_2_hash(\%hash, $ival, $sfn);
                    $ifdefcnt++;
                }
                #              0     1     2
                push(@ifstack,[$ityp,$ival,$lnn]);
            } elsif ($line =~ /^\s*\#\s*e(\w+)\s*(.*)$/) {
                $ityp = $1;
                $ival = trim_comments_from_line($2);
                if (length($ival)) {
                    $tail = " [$ival]";
                } else {
                    $tail = '';
                }
                if ($ityp eq 'lse') {
                    if (@ifstack) {
                        $ra = $ifstack[-1];
                        $tail .= ' // !['.${$ra}[1];
                        $tail .= '] '.${$ra}[2];
                    }
                    prt( "$ifcnt: Line:$clnn:l: ${hash}e".$ityp."$tail\n" ) if ($show);
                } elsif ($ityp eq 'ndif') {
                    $ifcnt = scalar @ifstack;
                    if (@ifstack) {
                        $ra = pop @ifstack;
                        $tail .= ' // ['.${$ra}[1];
                        $tail .= '] '.${$ra}[2];
                        $ifcnt = scalar @ifstack;
                    } else {
                        prtw("WARNING: Got an 'endif' with NO IF STACK [$sfn]$lnn\n");
                    }
                    $scnt = scalar @ifstack;
                    $ind = $indent x $scnt;
                    if ($indent_hash) {
                        $hash = $ind.'#';
                    } else {
                        $hash = '#'.$ind;
                    }
                    prt( "$ifcnt: Line:$clnn:n: ${hash}e".$ityp."$tail\n" ) if ($show);
                    if ($scnt) {
                        $ind = $indent x ($scnt - 1);
                        if ($indent_hash) {
                            $hash = $ind.'#';
                        } else {
                            $hash = '#'.$ind;
                        }
                    }
                    prt("IFSTACK is ZERO(0)\n") if (($ifcnt == 0) && $show);
                } else {
                    prt( "$ifcnt: Line:$clnn:?: ${hash}e".$ityp."$tail\n" ) if ($show);
                }
            }
        }
    }
    if (@ifstack) { 
        $scnt = scalar @ifstack;
        prtw("WARNING: Got 'eof' with IF STACK $scnt [$sfn]$lnn\n");
        for ($i = 0; $i < $scnt; $i++) {
            $ra = $ifstack[$i];
            #               0     1     2
            #push(@ifstack,[$ityp,$ival,$lnn]);
            $ityp = ${$ra}[0];
            $ival = ${$ra}[1];
            $lnn  = ${$ra}[2];
            prt("$lnn: #if$ityp [$ival]\n");
        }

    }
    return \%hash;
}

sub show_hash($) {
    my ($rh) = @_;
    my $cnt = scalar keys(%{$rh});
    prt( "\nFound $cnt 'ifdef' to show...\n" );
    $total_ifdef += $cnt;
    my ($min,$len,$key,$val,$msg,$tmp,$out,$max,$i,$file,$fcnt,@arr2);
    $msg = '';
    $tmp = '';
    $min = 0;
    my %found = ();
    my @arr = sort keys %{$rh};
    # get minimum length of the define
    foreach $key (@arr) {
        $len = length($key);
        $min = $len if ($len > $min);
        if (defined $find_defs{$key}) {
            $val = ${$rh}{$key};
            $found{$key} = $val;
        }
    }
    my @arr3 = sort keys %found;
    if (@arr3) {
        $cnt = scalar @arr3;
        prt("Found $cnt specific 'defines'...\n");
        foreach $key (@arr3) {
            $val = $found{$key};
            $key .= ' ' while (length($key) < $min);
            @arr2 = split(/\|/,$val);
            $max = scalar @arr2;
            prt( "$key = ($max) $val\n" );
        }
        return;
    } elsif ($find_count > 0) {
        @arr3 = keys %find_defs;
        prt("But none match '".join(",",@arr3)."', so showing ALL...\n");
    }
    $tmp = '';
    # get all the 'HAVE_...' variables
    foreach $key (@arr) {
        if ($key =~ /^HAVE/) {
            $tmp .= ' ' if length($tmp);
            $tmp .= $key;
            if (length($tmp) > 100) {
                $msg .= "\n" if length($msg);
                $msg .= $tmp;
                $tmp = '';
            }
        }
    }

    if (length($tmp)) {
       $msg .= "\n" if length($msg);
       $msg .= $tmp;
       $tmp = '';
    }

    foreach $key (@arr) {
        if ( !($key =~ /^HAVE/) ) {
            $tmp .= ' ' if length($tmp);
            $tmp .= $key;
            if (length($tmp) > 100) {
                $msg .= "\n" if length($msg);
                $msg .= $tmp;
                $tmp = '';
            }
        }
    }
    if (length($tmp)) {
       $msg .= "\n" if length($msg);
       $msg .= $tmp;
       $tmp = '';
    }

    $min = $max_max if ($min > $max_max);
    foreach $key (@arr) {
        $val = ${$rh}{$key};
        $key .= ' ' while (length($key) < $min);
        if ($show_all_dupes) {
            prt( "$key = $val\n" );
        } else {
            $out = "$key = ";
            my %files = ();
            @arr2 = split(/\|/,$val);
            $max = scalar @arr2;
            for ($i = 0; $i < $max; $i++) {
                $file = $arr2[$i];
                $files{$file} = 1;
            }
            @arr2 = sort keys %files;
            $fcnt = scalar @arr2;
            prt("$key = ($fcnt)");
            if ($show_all_files) {
                prt(" ".join("|",@arr2));
            }
            prt("\n");
        }
    }

    #######################################
    if (VERB2()) {
        prt( "\nAnd as a simple list...\n" );
        prt( "$msg\n" );
    } else {
        prt("\n-v2 to show a simple list...\n");
    }
    ########################################
}

sub process_inputs() {

    push(@files_list, @in_files);
    foreach $in_dir (@in_dirs) {
        process_dir($in_dir, \%exclude_dirs, \%exclude_files, \@files_list );
    }
    my $ref_hash = process_files( \@files_list );
    show_hash($ref_hash);
    prt( "Found $total_ifdef IF[[N]DEF], from $total_files files, $total_lines lines, excluded $excluded_file...\n" );
}

### MAIN ###
#######################################
parse_args(@ARGV);
process_inputs();
pgm_exit(0,"");
########################################

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/) {
                $load_log = 1;
                prt("Set to load log at end.\n") if (VERB1());
            } elsif ($sarg =~ /^s/) {
                $show_all_files = 1;
                prt("Set to show all files.\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 =~ /^x/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $exclude_files{$sarg} = 2;
                prt("Set to exclude file to [$sarg].\n") if (VERB1());
            } elsif ($sarg =~ /^X/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $exclude_dirs{$sarg} = 2;
                prt("Set to exclude directory to [$sarg].\n") if (VERB1());
            } elsif ($sarg =~ /^f/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $find_defs{$sarg} = 1;
                prt("Set to find a define [$sarg].\n") if (VERB1());
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            if (-f $arg) {
                $in_file = $arg;
                push(@in_files,$in_file);
                prt("Added file input [$in_file]\n") if (VERB1());
            } elsif (-d $arg) {
                $in_dir = $arg;
                push(@in_dirs,$in_dir);
                prt("Added directory input [$in_dir]\n") if (VERB1());
            } else {
                pgm_exit(1,"ERROR: Input [$arg] is neither file nor directory!\n");
            }
        }
        shift @av;
    }

    if ((length($in_file) ==  0) && $debug_on && (-d $def_in_dir)) {
        $in_dir = $def_in_dir;
        push(@in_dirs,$in_dir);
        prt("Set DEFAULT input to directory [$in_dir]\n");
    }
    if ((length($in_file) ==  0) && (length($in_dir) == 0)) {
        pgm_exit(1,"ERROR: No input files or directories found in command!\n");
    }
    $find_count = scalar keys %find_defs;
}

sub give_help {
    prt("$pgmname: version $VERS\n");
    prt("Usage: $pgmname [options] in-file [in-dir [...]]\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(" --xclude <file> (-x) = Exclude file from search.\n");
    prt(" --Xclude <dir>  (-X) = Exclude directory from search.\n");
    prt(" --show          (-s) = Show file names for each define.\n");
    prt(" --find DEF      (-f) = Find DEF's in file.\n");

}

#############################

# eof

index -|- top

checked by tidy  Valid HTML 4.01 Transitional