chkbraces.pl to HTML.

index -|- end

Generated: Mon Aug 29 19:34:16 2016 from chkbraces.pl 2015/04/17 19.6 KB. text copy

#!/usr/bin/perl -w
# chkbraces.pl
# To read a C/C++ file, and check braces
# 08/04/2013 - Remove some uninitialized values
# 30/05/2012 - Some improvement in the UI and file handling
# 20110409 - Port to Ubuntu, default to 'c' type, and add [$line] to error output
# 11/08/2010 - fix small problem for -type p...
# 20061225 - include logfile.pl, and allow command line input
use strict;
use warnings;
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 $pgm_vers = "0.0.3 2012-05-30";
###my $pgm_vers = "0.0.2 2011-04-09";
my $in_file = '';
my $opt_typ = 'c';
my ($line, $ib, $pos, $lb, $len, $chr, $coff, $pl, $min, $mlen, $oln, $cln, $pchr);
my $load_log = 0;

my $dbg_file = '';
# debug output
my $dbg1 = 0;   # output each open and close
my $dbg2 = 0;   # output skipped data
my $maxout = 90;
my $verbosity = 0;

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

parse_arguments(@ARGV);

open IF, "<$in_file" or mydie( "Can not OPEN [$in_file]! ... $! ... aborting ...\n" );
my @file_lines = <IF>; # slurp whole file, to an array of lines
close(IF);
my $cnt = scalar @file_lines;
my $lncount = $cnt;
prt( "File [$in_file] ($opt_typ) has $lncount lines ...\n" );
my @bracelist = ();
my @allbraces = ();
my $errclose = '';
my $skipped = '';
my $skipped_lines = 0;

sub get_indent($) {
    my $line = shift;
    my $ind = '';
    while ($line =~ /^\s/) {
        $ind .= substr($line,0,1);
        $line = substr($line,1);
    }
    return $ind;
}

sub process_lines2($) {
    my ($ra) = @_;
    my $max = scalar @{$ra};
    my ($j,$ln,$mx,$pc,$ch,@br,@all,$ii,$ct,$qc);
    my ($ms);
    my $incomm = 0;
    my $inquot = 0;
    my $quote = '';
    my $comm = '';
    $ch = '';
    @br = ();
    @all = ();
    for ($j = 0; $j < $max; $j++) {
        $ln = ${$ra}[$j];
        chomp $ln;
        $mx = length($ln);
        for ($ii = 0; $ii < $mx; $ii++) {
            $pc = $ch;
            $ch = substr($ln,$ii,1);
            $ct = scalar @br;
            $ms = "$j:$ii:$ct";
            if ($inquot) {
                # skip over QUOTED text
                if ($ch eq $qc) {
                    $inquot = 0;
                    prt("$ms - end quote '$quote'\n") if (VERB5());
                } else {
                    $quote .= $ch;
                }
            } else {
                if ($ch eq '"') {
                    $inquot = 1;
                    $qc = $ch;
                    prt("$ms - begin quote\n") if (VERB5());
                    $quote = '';
                } elsif ($ch eq '{') {
                    $ms .= " open";
                    push(@br, $ms);
                    push(@all, $ms);
                } elsif ($ch eq '}') {
                    if (@br) {
                        pop @br;
                        $ct = scalar @br;
                        $ms = "$j:$ii:$ct";
                    } else {
                        prt("$ms - got close without open!\n");
                    }
                    $ms .= " close";
                    push(@all,$ms);
                } else {
                    if ($opt_typ eq 'c') {
                        if (($ch eq '/') && ($pc eq '/')) {
                            if (length($ln) > $ii) {
                                $comm = substr($ln,$ii-1);
                                prt("Skipped inline comment\n$comm\n") if (VERB9());
                            }
                            last;   # skip rest of line
                        } elsif (($ch eq '*')&&($pc eq '/')) {
                            $ii++;
                            $incomm = 1;
                            $comm = $pc.$ch;
                            while ($incomm && ($j < $max)) {
                                for (; $ii < $mx; $ii++) {
                                    $pc = $ch;
                                    $ch = substr($ln,$ii,1);
                                    $ms = "$j:$ii:$ct";
                                    $comm .= $ch;
                                    if (($ch eq '/')&&($pc eq '*')) {
                                        $incomm = 0;
                                        prt("Skipped comment\n$comm\n") if (VERB9());
                                        last;
                                    }
                                }
                                if ($incomm) {
                                    $j++;
                                    $comm .= "\n";
                                    if ($j < $max) {
                                        $ln = ${$ra}[$j];
                                        chomp $ln;
                                        $mx = length($ln);
                                        $ii = 0;
                                    }
                                }
                            }
                        }
                    } elsif ($opt_typ eq 'p') {
                        last if ($ch eq '#');
                    }
                }
            }
        }
    }
    my %hash = ();
    $hash{'oc'} = [ @br ];
    $hash{'all'} = [ @all ];
    return \%hash;
}


sub process_lines($) {
    my ($ra) = @_;
    my $max = scalar @{$ra};
    my ($j,$ln,$mx,$pc,$ch,@br,@all,$ii,$ct);
    my ($ms);
    my $incomm = 1;
    $ch = '';
    @br = ();
    @all = ();
    for ($j = 0; $j < $max; $j++) {
        $ln = ${$ra}[$j];
        chomp $ln;
        $mx = length($ln);
        for ($ii = 0; $ii < $mx; $ii++) {
            $pc = $ch;
            $ch = substr($ln,$ii,1);
            $ct = scalar @br;
            $ms = "$j:$ii:$ct";
            if ($ch eq '{') {
                $ms .= " open";
                push(@br, $ms);
                push(@all, $ms);
            } elsif ($ch eq '}') {
                if (@br) {
                    pop @br;
                    $ct = scalar @br;
                    $ms = "$j:$ii:$ct";
                } else {
                    prt("$ms - got close without open!\n");
                }
                $ms .= " close";
                push(@all,$ms);
            } else {
             if ($opt_typ eq 'c') {
                    if (($ch eq '/') && ($pc eq '/')) {
                        last;   # skip rest of line
                    } elsif (($ch eq '*')&&($pc eq '/')) {
                        $ii++;
                        $incomm = 1;
                        while ($incomm && ($j < $max)) {
                            for (; $ii < $mx; $ii++) {
                                $pc = $ch;
                                $ch = substr($ln,$ii,1);
                                $ms = "$j:$ii:$ct";
                                if (($ch eq '/')&&($pc eq '*')) {
                                    $incomm = 0;
                                    last;
                                }
                            }
                            if ($incomm) {
                                $j++;
                                if ($j < $max) {
                                    $ln = ${$ra}[$j];
                                    chomp $ln;
                                    $mx = length($ln);
                                }
                            }
                        }
                    }
             } elsif ($opt_typ eq 'p') {
                last if ($ch eq '#');
                }
            }
        }
    }
    my %hash = ();
    $hash{'oc'} = [ @br ];
    $hash{'all'} = [ @all ];
    return \%hash;
}

sub show_hash_ref($) {
    my ($hr) = @_;
    my $ha = ${$hr}{'oc'};
    my $ct = scalar @{$ha};
    if ($ct == 0) {
        prt("Looks like all items resolved...\n");
    }
    prt("Got $ct open braces...\n");
    $ha = ${$hr}{'all'};
    $ct = scalar @{$ha};
    prt("Showing all $ct braces...\n");
    foreach my $ms (@{$ha}) {
        prt( "$ms\n");
    }
}

my $hash_ref = process_lines2(\@file_lines);
###my $hash_ref = process_lines(\@lines);
#show_hash_ref($hash_ref);
#close_log($outfile,1);
#exit(0);

sub do_line_count() {

    $cnt = 0;
    $pos = 0;
    $ib = 0;
    $lb = 0;
    $chr = '';
    $coff = 0;
    $pl = '';

    $min = 0;
    $mlen = 8; # 12 - 5;
    $oln = 0;
    $cln = 0;
    my $msg = '';
    my $inquote = 0;
    #foreach $line (@lines) {
    for (my $j = 0; $j < $lncount; $j++) {
        $line = $file_lines[$j];
        $cnt++;
        chomp $line;
        $len = length($line);
        $coff = 0;
        $pchr = '';
        my $tline = trim_all($line);
        for (my $i = 0; $i < $len; $i++) {
            $coff++;
            $chr = substr($line, $i, 1); # get a char
            if ($inquote) {
                if ($chr eq '"') {
                    $inquote = 0;
                }
            } elsif($chr eq '"') {
                $inquote = 1;
            } elsif($chr eq '{') {
                ### $msg = "$cnt:$coff";
                $msg = sprintf("%3d:%3d", $cnt,$coff);
                push(@bracelist, [$ib, $msg] );
                push(@allbraces, [$ib, $msg, "opend", $line, $tline] );
                $mlen = length($msg);
                if ($mlen > $min) { $min = $mlen; }
                if ($cln == $cnt) {
                    $pl = ret_diff($pl, substr($line, 0, $i+1)); 
                } else {
                    $pl = substr($line, 0, $i+1);
                }
                while(length($msg) < $min) { $msg .= ' '; }
                prt( "$msg - open  $ib ...$pl\n" ) if ($dbg1);
                $oln = $cnt; # set openning line number
                $ib++;
            } elsif ($chr eq '}') {
                if ($ib) {
                    $ib--;
                }
                ### $msg = "$cnt:$coff";
                $msg = sprintf("%3d:%3d", $cnt,$coff);
                push(@allbraces, [$ib, $msg, "close", $line, $tline] );
                if (@bracelist) {
                    pop(@bracelist);
                } else {
                    $errclose .= "Error close at $msg ...\n";
                }
                $mlen = length($msg);
                if ($mlen > $min) { $min = $mlen; }
                while( length($msg) < $min) { $msg .= ' '; }
                if ($oln == $cnt) {
                    $pl = ret_diff($pl, substr($line, 0, $i+1)); 
                } else {
                    $pl = substr($line, 0, $i+1);
                }
                prt( "$msg - close $ib ...$pl\n" ) if ($dbg1);
                $cln = $cnt; # set close line
            } else {
                if ($opt_typ eq 'c') {
                    if (($chr eq '/') && ($pchr eq '/')) {
                        prt( "Skipped 1 /". substr($line, $i) . "\n" ) if ($dbg2);
                        $pchr = '-';
                        last;
                    } elsif (($chr eq '*') && ($pchr eq '/')) {
                        # /* ... */ must each chars until */ ...
                        $i++;
                        $skipped = '/*';
                        while( !( ( $chr eq '/' ) && ($pchr eq '*') ) && ($j < $lncount) ) {
                            for (; $i < $len; $i++) {
                                $coff++;
                                $chr = substr($line, $i, 1); # get a char
                                if( ( $chr eq '/' ) && ($pchr eq '*') ) {
                                    $skipped .= $chr;
                                    prt( "Skipped 2 $skipped\n" ) if ($dbg2);
                                    last;
                                }
                                $pchr = $chr;
                                $skipped .= $chr;
                            }
                            if ( !(( $chr eq '/' ) && ($pchr eq '*')) ) {
                                $j++;
                                $skipped .= "\n";
                                if( $j < $lncount ) {
                                    $line = $file_lines[$j];
                                    $cnt++;
                                    chomp $line;
                                    $len = length($line);
                                    $coff = 0;
                                    $i = 0;
                                }
                            }
                        }
                        $chr  = '-';
                        $pchr = '-';
                    }
                } elsif ($opt_typ eq 'p') {
                    if ($chr eq '#') {
                        last;
                    }
                }
            }
            $pchr = $chr;
        }
    }
}

do_line_count();

if (length($errclose)) {
   prt( "Check close error(s) ...\n" );
   prt( $errclose );
}

sub do_brace_list() {
    my $msg = '';
    if (@bracelist) {
        $cnt = scalar @bracelist;
        prt( "Check $cnt unclosed braces, and/or try other options ...\n" );
        my $last_line = '';
        my $next_line = '';
        my $indent = '';
        for ($oln = 0; $oln < $cnt; $oln++) {
            $msg = $bracelist[$oln][1];
            my @arr = split(':', $msg);
            prt( "\n$msg $bracelist[$oln][0] ... lines = \n" );
            $len = $arr[0];
            my $msglns = getLines( $len );
            prt( $msglns );
            my $abcnt = scalar @allbraces;
            for (my $k = 0; $k < $abcnt; $k++) {
                if( $msg eq $allbraces[$k][1] ) {
                    $k++;
                    my $out = 0;
                    for (; $k < $abcnt; $k++) {
                        $next_line = $allbraces[$k][3];
                        $indent = get_indent($next_line);
                        #prt( "$allbraces[$k][1] $allbraces[$k][0] $allbraces[$k][2]\n" );
                        if ($next_line eq $last_line) {
                            prt( "$allbraces[$k][1] $allbraces[$k][0] $allbraces[$k][2] [$indent<same line>]\n" );
                        } else {
                            prt( "$allbraces[$k][1] $allbraces[$k][0] $allbraces[$k][2] [".$allbraces[$k][3]."]\n" );
                        }
                        $out++;
                        if ($out > $maxout) {
                            prt("Stopping output due to maxout = $maxout\n");
                            last;
                        }
                        $last_line = $next_line;
                    }
                    last;
                }
            }
        }
    } else {
        prt( "Appears no open braces ...\n" );
    }
}
do_brace_list();

close_log($outfile,$load_log);
exit(0);

######################################
# functions
sub getLines {
   my ($off) = shift;
   my $lns = '';
   if ($off > 2) {
      $lns .= $file_lines[$off-2];
      $lns .= "\n" if (substr($lns, length($lns)-1) ne "\n");
   }
   if ($off > 1) {
      $lns .= $file_lines[$off-1];
      $lns .= "\n" if (substr($lns, length($lns)-1) ne "\n");
   }
   if ($off < $lncount) {
      $lns .= $file_lines[$off];
      $lns .= "\n" if (substr($lns, length($lns)-1) ne "\n");
   }
   return $lns;
}


sub ret_diff {
   my ($prv, $cur) = @_;
   my $ret = '';
   my $ln1 = length($prv);
   my $ln2 = length($cur);
#   prt("Comparing [$prv]$ln1 with [$cur]$ln2 ...\n");
   if ($ln1 < $ln2) {
      my ($i, $c1, $c2);
      for ($i = 0; $i < $ln1 ; $i++) {
         $c1 = substr($prv, $i, 1);
         $c2 = substr($cur, $i, 1);
         if (($c1 eq $c2)||($c1 eq ' ')) {
            $ret .= ' ';
         } else {
#            prt("Got diff char [$c1] vs [$c2]...\n");
            last;
         }
      }
#      prt("Adding [".substr($cur, $i)." to [$ret] ...\n");
      $ret .= substr($cur, $i);
   } else {
      $ret = $cur;
   }
   return $ret;
}

sub get_my_name {
   my $me = $0;
   if ($0 =~ /^\w{1}:\\.*/) {
      my @tmpsp = split(/\\/,$0);
      $me = $tmpsp[-1];
   }
   return $me;
}

# Ensure argument exists, or die.
sub require_argument {
    my ($arg, @arglist) = @_;
    mydie( "ERROR: No argument given for option '$arg'\n" ) if ! @arglist;
}


sub give_little_help {
   prt("$pgmname [Options] [-f] in_file_name\n" );
   prt(" --help (-h -?) = this brief help\n" );
   prt(" -type p|c|n    = assume perl, C/C++ file, or no specific type ... ($opt_typ)\n" );
   prt(" -maxout NUM    = Output number, if brace error found ... ($maxout)\n" );
    prt(" --log     (-l) = Load log file at end\n");
    prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n");
   mydie( " [-f] in_file_name = file to do braces check on ... ($in_file)\n" );
}

# parseargs
sub parse_arguments {
    my @av = @_;
    my $arg = '';
    my $sarg = '';
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if ($arg eq '--help' || $arg eq '-h' || $arg eq '-?') {
                give_little_help(); # show help and exit
            } elsif ( $arg eq '-f' ) {
                require_argument( @av );
                shift @av;
                $arg = $av[0];
                $in_file = $arg;
                prt( "Set IN file to [$in_file] ...\n" );
            } elsif ( $arg eq '-dbg1' ) {
                $dbg1 = 1;
                prt( "Set \$dbg1 ...\n" );
            } elsif ( $arg eq '-dbg2' ) {
                $dbg2 = 1;
                prt( "Set \$dbg2 ...\n" );
            } elsif ( $arg eq '-maxout' ) {
                require_argument( @av );
                shift @av;
                $arg = $av[0];
                $maxout = $arg;
                prt( "Set \$maxout on error to $maxout ...\n" );
            } elsif ( $arg eq '-type' ) {
                require_argument( @av );
                shift @av;
                $arg = $av[0];
                if (($arg eq 'c')||($arg eq 'p')||($arg eq 'n')) {
                    $opt_typ = $arg;
                    prt( "Set assumed file type [$opt_typ] ". (($opt_typ eq 'c') ? "C/C++" :
                        ($opt_typ eq 'p') ? "Perl" : "None") . " ...\n" );
                } else {
                    mydie( "Error -type not followed by 'c', 'p' or 'n' ... aborting ...\n" );
                }
            } elsif ($sarg =~ /^l/) {
                if ($sarg =~ /^ll/) {
                    $load_log = 2;
                } else {
                    $load_log = 1;
                }
            } elsif ($sarg =~ /^v/) {
                if ($sarg =~ /^v.*(\d+)$/) {
                    $verbosity = $1;
                } else {
                    while ($sarg =~ /^v/) {
                        $verbosity++;
                        $sarg = substr($sarg,1);
                    }
                }
                prt("Verbosity = $verbosity\n") if (VERB1());
            } else {
                mydie( "$pgmname: Unrecognised option, namely '$arg'\nTry --help or -? for some information.\n" );
            }
      } else {
         $in_file = $arg;
         prt( "Set IN file to [$in_file] ...\n" );
      }
      shift @av;
   }

    if (length($in_file) == 0) {
        if (length($dbg_file)) {
            $in_file = $dbg_file;
        } else {
            prt("$pgmname: ERROR: No imput file found in command!\n");
            exit(1);
        }
    }
    if (! -f $in_file) {
        prt("$pgmname: ERROR: Unable to locate input file!\n");
        exit(1);
    }
}

# eof - chkbraces.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional