countfile.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:29 2010 from countfile.pl 2007/11/05 9.1 KB.

#!/perl -w
# NAME: countfile.pl
# AIM: Load the templines.txt file, and process the extries more 
# 03/11/2007 geoff mclane - http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$pgmname);
   $pgmname = $tmpsp[-1];
}
my $outfile = "temp.$pgmname.txt";
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
##my $in_file = "templines.txt";
my $in_file = "templine2.txt";
my $file_count = 0;
my %extcount = ();
my @ba_anal = ();
my @ba_onef = ();
my @oper1 = ( '=', '+', '-', '/', "\\", '>', '<' );
my @oper2 = ( '==', '++', '--', '>>', '>=', '<<', '<=' );
my @punct = ( '(', ';', ",", ')' );
# debug
my $dbg5 = 0;
my $dbg6 = 0;
my $dbg7 = 0;
# type counts
my $type_0_0 = 0;
my $type_0_1 = 0;
my $type_0_2 = 0;
my $type_1_0 = 0;
my $type_1_1 = 0;
my $type_1_2 = 0;
my $cnt = 0;
my $const_count = 0;
my $const_charp = 0;
my $const_other = 0;
if (open INF, "<$in_file") {
   my @lines = <INF>;
   close INF;
   my ($nm, $dir, $ext, $prj, $fc, $lnc, $lcext, $bcnt, $acnt, $msg);
   my $lncnt = scalar @lines;
   prt("Processing $lncnt lines from $in_file ...\n");
   $lncnt = 0;
   my $file = '';
   my $no_ext = 0;
   foreach my $line (@lines) {
      chomp $line;
      if ($line =~ /^FILE:\s+(.*)/) {
         $file_count++;
         if (length($file)) {
            ($nm, $dir, $ext) = fileparse( $file, qr/\.[^.]*/ );
            # like OpenSceneGraph
            $prj = $dir;
            $prj = substr($dir,9) if (length($dir) > 9); 
            $fc = "$file_count";
            while (length($fc) < 5) {
               $fc .= " ";
            }
            $lnc = "$lncnt";
            while (length($lnc) < 5) {
               $lnc = " $lnc";
            }
            if (length($ext)) {
               $lcext = lc($ext);
               if (defined $extcount{$lcext}) {
                  $extcount{$lcext} += 1;
               } else {
                  $extcount{$lcext} = 1;
               }
            } else {
               $no_ext++;
            }
            $cnt = scalar @ba_onef;
            ###prt( "Got $cnt results ...\n" );
            $type_0_0 = 0;
            $type_0_1 = 0;
            $type_0_2 = 0;
            $type_1_0 = 0;
            $type_1_1 = 0;
            $type_1_2 = 0;
            for (my $i = 0; $i < $cnt; $i++) {
               $bcnt = $ba_onef[$i][0];
               $acnt = $ba_onef[$i][1];
               if ($bcnt) {
                  if ($acnt == 0) {
                     $type_1_0++;
                  } elsif ($acnt > 1) {
                     $type_1_2++;
                  } else {
                     $type_1_1++;
                  }
               } else {
                  if ($acnt == 0) {
                     $type_0_0++;
                  } elsif ($acnt > 1) {
                     $type_0_2++;
                  } else {
                     $type_0_1++;
                  }
               }
            }
            #                                               48                 58 
            #01234567891123456789212345678931234567894123456789512345678961235678
            # 394   FILE:    4: cmAddCustomCommandCommand.cxx 0_1=1, 1_0=1,      (2) CMake\Source\
            $msg = "$fc FILE:$lnc: $nm"."$ext ";
            while (length($msg) < 48) {
               $msg .= " ";
            }
            $msg .= "0_0=$type_0_0, " if ($type_0_0);
            $msg .= "0_1=$type_0_1, " if ($type_0_1);
            $msg .= "0_2=$type_0_2, " if ($type_0_2);
            $msg .= "1_0=$type_1_0, " if ($type_1_0);
            $msg .= "1_1=$type_1_1, " if ($type_1_1);
            $msg .= "1_2=$type_1_2  " if ($type_1_2);
            while (length($msg) < 58) {
               $msg .= " ";
            }
            prt( "$msg ($cnt) $prj\n" );
            @ba_onef = ();
            $lncnt = 0;
         }
         $file = $1;
         ###prt( "FILE: $file\n" );
      } else {
         $lncnt++;
         my $tline = trim_all($line); # get a tidy line
         analyse_line($tline);
      }
   }
   ($nm, $dir, $ext) = fileparse( $file, qr/\.[^.]*/ );
   # like OpenSceneGraph
   $prj = $dir;
   $prj = substr($dir,9) if (length($dir) > 9); 
   $fc = "$file_count";
   while (length($fc) < 5) {
      $fc .= " ";
   }
   $lnc = "$lncnt";
   while (length($lnc) < 5) {
      $lnc = " $lnc";
   }
   if (length($ext)) {
      $lcext = lc($ext);
      if (defined $extcount{$lcext}) {
         $extcount{$lcext} += 1;
      } else {
         $extcount{$lcext} = 1;
      }
   } else {
      $no_ext++;
   }
   $cnt = scalar @ba_onef;
   ###prt( "Got $cnt results ...\n" );
   $type_0_0 = 0;
   $type_0_1 = 0;
   $type_0_2 = 0;
   $type_1_0 = 0;
   $type_1_1 = 0;
   $type_1_2 = 0;
   for (my $i = 0; $i < $cnt; $i++) {
      $bcnt = $ba_onef[$i][0];
      $acnt = $ba_onef[$i][1];
      if ($bcnt) {
         if ($acnt == 0) {
            $type_1_0++;
         } elsif ($acnt > 1) {
            $type_1_2++;
         } else {
            $type_1_1++;
         }
      } else {
         if ($acnt == 0) {
            $type_0_0++;
         } elsif ($acnt > 1) {
            $type_0_2++;
         } else {
            $type_0_1++;
         }
      }
   }
   #                                               48                 58 
   #01234567891123456789212345678931234567894123456789512345678961235678
   # 394   FILE:    4: cmAddCustomCommandCommand.cxx 0_1=1, 1_0=1,      (2) CMake\Source\
   $msg = "$fc FILE:$lnc: $nm"."$ext ";
   while (length($msg) < 48) {
      $msg .= " ";
   }
   $msg .= "0_0=$type_0_0, " if ($type_0_0);
   $msg .= "0_1=$type_0_1, " if ($type_0_1);
   $msg .= "0_2=$type_0_2, " if ($type_0_2);
   $msg .= "1_0=$type_1_0, " if ($type_1_0);
   $msg .= "1_1=$type_1_1, " if ($type_1_1);
   $msg .= "1_2=$type_1_2  " if ($type_1_2);
   while (length($msg) < 58) {
      $msg .= " ";
   }
   prt( "$msg ($cnt) $prj\n" );
   prt( "Total $file_count files, those with NO extension = $no_ext ...\n" );
   my $wrap = 0;
   foreach $ext (keys %extcount) {
      prt( "$ext=".$extcount{$ext}." " );
      $wrap++;
      if ($wrap > 10) {
         prt("\n");
         $wrap = 0;
      }
   }
   prt( "\n" ) if ($wrap);
} else {
   prt( "ERROR: Unable to open file $in_file ... $! ...\n" );
}
$cnt = scalar @ba_anal;
prt( "Got $cnt results ...\n" );
$type_0_0 = 0;
$type_0_1 = 0;
$type_0_2 = 0;
$type_1_0 = 0;
$type_1_1 = 0;
$type_1_2 = 0;
for (my $i = 0; $i < $cnt; $i++) {
   my $bcnt = $ba_anal[$i][0];
   my $acnt = $ba_anal[$i][1];
   if ($bcnt) {
      if ($acnt == 0) {
         $type_1_0++;
      } elsif ($acnt > 1) {
         $type_1_2++;
      } else {
         $type_1_1++;
      }
   } else {
      if ($acnt == 0) {
         $type_0_0++;
      } elsif ($acnt > 1) {
         $type_0_2++;
      } else {
         $type_0_1++;
      }
   }
}
prt( "0_0=$type_0_0, 0_1=$type_0_1, 0_2=$type_0_2, 1_0=$type_1_0, 1_1=$type_1_1, 1_2=$type_1_2 ($cnt)\n" );
##for (my $i = 0; $i < $cnt; $i++) {
##   prt( "Before $ba_anal[$i][0] - const - After $ba_anal[$i][1]\n" );
##}
prt( "Out of $const_count 'const', $const_charp were 'const char *', and $const_other were 'const some*' ...\n" );
close_log($outfile,1);
exit(0);
sub is_punct {
   my ($c) = shift;
   foreach my $tc (@punct) {
      if ($c eq $tc) {
         return 1;
      }
   }
   return 0;
}
sub is_oper1 {
   my ($c) = shift;
   foreach my $tc (@oper1) {
      if ($c eq $tc) {
         return 1;
      }
   }
   return 0;
}
sub is_p_or_op {
   my ($cc) = shift;
   if (is_oper1($cc) || is_punct($cc) ) {
      return 1;
   }
   return 0;
}
sub analyse_arr {
   my (@arr) = @_;
   my $al = scalar @arr;
   my @ba = ();
   if ($al) {
      prt( join( ' + ', @arr)."\n" ) if ($dbg5);
      my $had_const = 0;
      my $before = 0;
      my $after = 0;
      foreach my $prt (@arr) {
         if ($had_const) {
            if ($prt =~ /^char\*/) {
               $const_charp++;
            } elsif ($prt =~ /^\w+\*/) {
               $const_other++;
            }
         }
         if ($prt eq 'const') {
            if ($had_const) {
               ##print "Before $before - const - After $after\n";
               push(@ba, [$before, $after]);
               $before++;   # now count a BEFORE for the next const
               $after = 0; # but kill the AFTER stuff
            }
            $had_const = 1;
         } elsif ($prt eq 'static') {
            # forget it
         } elsif ($prt eq 'ATTR_UNUSED') {
            # forget it
         } elsif ($prt =~ /\*$/) {
            prt( "Has trailing ptr ...\n" ) if ($dbg6);
            if ($had_const) {
               $after++ if (!$after);
               $after++;
            } else {
               $before++;
            }
         } else {
            if ($had_const) {
               $after++;
            } else {
               $before++;
            }
         }
      }
      if(@ba) {
         $ba[-1][1] += $after;
      }
      push(@ba, [$before, $after]);
      ##print "Before $before - const - After $after\n";
      my $bal = scalar @ba;
      if ($dbg7) {
         prt( "Array of $bal entries ...\n" );
         for (my $i = 0; $i < $bal; $i++) {
            prt( "Before $ba[$i][0] - const - After $ba[$i][1]\n" );
         }
      }
      push(@ba_anal, @ba);   # accumlated totals
      push(@ba_onef, @ba);   # just for this FILE
   }
}
sub analyse_line {
   my ($tl) = shift;
   # analyse the use of 'const' = before, inbetween, last
   my @narr = ();
   my $ll = length($tl);
   my $done = '';
   my $got_const = 0;
   my $pch = '';
   for (my $i = 0; $i < $ll; $i++) {
      my $ch = substr($tl,$i,1);
      if ($ch =~ /\s/) {
         if (length($done)) {
            push(@narr,$done);
            if ($done eq 'const') {
               $got_const = 1;
               $const_count++;
            }
         }
         $done = '';
         $pch = $ch;
         next;
      } elsif ($ch eq '*') {
         if ($pch =~ /\s/) {
            my $alen = scalar @narr;
            if ($alen) {
               $narr[$alen - 1] .= $ch;
               $pch = $ch;
               next;
            }
         } # else add to $done
      } elsif ( is_p_or_op($ch) ) {
         # reacehd the end of a code CHUNK
         if (length($done)) {
            push(@narr,$done);
            if ($done eq 'const') {
               $got_const = 1;
               $const_count++;
            }
         }
         $done = '';
         $pch = $ch;
         analyse_arr(@narr) if ($got_const);
         $got_const = 0;
         @narr = ();
         next;
      }
      $done .= $ch;
      $pch = $ch;
   }
   push(@narr,$done) if (length($done));
   analyse_arr(@narr) if ($got_const);
}
# eof

index -|- top

checked by tidy  Valid HTML 4.01 Transitional