chkbraces.pl to HTML.

index -|- end

Generated: Sun Aug 21 11:10:40 2011 from chkbraces.pl 2011/04/09 11.9 KB.

#!/usr/bin/perl -w
# chkbraces.pl
# To read a C/C++ file, and check braces
# 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 $pgm_vers = "0.0.2 2011-04-09";
my $os = $^O;
my ($perl_dir,$out_dir,$ufile);
if ($os =~ /Win/i) {
$perl_dir = 'C:\GTools\perl';
$out_dir = $perl_dir;
$ufile = 'logfile.pl';
} else {
$perl_dir = '/home/geoff/bin';
$out_dir = '/tmp';
$ufile = 'logfileu.pl';
}
# =========================================================
unshift(@INC, $perl_dir);
require $ufile or die "Unable to load '$ufile'...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $out_dir."/temp.$pgmname.txt";


my $in_file = '';
my $opt_typ = 'c';
my ($line, $ib, $pos, $lb, $len, $chr, $coff, $pl, $msg, $min, $mlen, $oln, $cln, $pchr);

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

open_log($outfile);

parse_arguments(@ARGV);

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

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


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("$msg - 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_lines(\@lines);
#show_hash_ref($hash_ref);
#close_log($outfile,1);
#exit(0);

$cnt = 0;
$pos = 0;
$ib = 0;
$lb = 0;
$chr = '';
$coff = 0;
$pl = '';
$msg = '';
$min = 0;
$mlen = 8; # 12 - 5;
$oln = 0;
$cln = 0;
#foreach $line (@lines) {
for (my $j = 0; $j < $lncount; $j++) {
   $line = $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($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 = $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;
   }
}

if (length($errclose)) {
   prt( "Check close error(s) ...\n" );
   prt( $errclose );
}
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) {
                  last;
               }
                    $last_line = $next_line;
            }
            last;
         }
      }
   }
} else {
   prt( "Appears no open braces ...\n" );
}
close_log($outfile,1);
exit(0);

######################################
# functions
sub getLines {
   my ($off) = shift;
   my $lns = '';
   if ($off > 2) {
      $lns .= $lines[$off-2];
      $lns .= "\n" if (substr($lns, length($lns)-1) ne "\n");
   }
   if ($off > 1) {
      $lns .= $lines[$off-1];
      $lns .= "\n" if (substr($lns, length($lns)-1) ne "\n");
   }
   if ($off < $lncount) {
      $lns .= $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 or -h or -? = 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" );
   mydie( "   [-f] in_file_name = file to do braces check on ... ($in_file)\n" );
}

# parseargs
sub parse_arguments {
    my @av = @_;
    my $arg = '';
    while (@av) {
        $arg = $av[0];
        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 ($arg =~ /^-/) {
            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);
        }
    }
}

# eof - chkbraces.pl

index -|- top