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