#!/usr/bin/perl -w
use strict;
use Getopt::Long;
my( @files, $subs, $code_lines, $comment_lines, $loops, $tests, $match
+es,
$substitutes, $translations, $help );
&GetOptions( "subroutines" => \$subs,
"code" => \$code_lines,
"comments" => \$comment_lines,
"loops" => \$loops,
"help" => \$help );
# After GetOptions is done, the only thing left should be file names,
+so grab
# them and put them in the array. This allows shell meta-characters to
+ be
# expanded, ie. '*.pl'
@files = @ARGV;
my $all = (!$subs and !$code_lines and !$comment_lines and !$loops and
+ !$help);
&help if( $help );
foreach my $file ( @files ) {
open( IN, "$file" ) or print "** Couldn't open $file **\n" and nex
+t;
&count_code( *IN ) if( $code_lines or $all );
&count_comments( *IN ) if( $comment_lines or $all );
&count_loops( *IN ) if( $loops or $all );
&count_subs( *IN ) if( $subs or $all );
close( IN ) or print "** Couldn't close $file **\n" and last;
}
######################################################################
+##########
################################# SUBROUTINES ########################
+#########
######################################################################
+##########
######################################################################
+##########
# help()
sub help {
print <<END;
$0 usage: $0 [ options ] file1 [file2 ..]
Note: If no options are given, all are applied to each file
options:
--s[ubroutines] Count the number of subroutines
--code Count the lines of actual code
--comments Count the lines that are only comments
--l[oops] Count the number of loops
--h[elp] This message
END
}
######################################################################
+##########
# count_subs( $file )
sub count_subs {
my( $input ) = shift;
my $count = my $name = "";
my $line_num = 1;
my @subs = ();
seek( $input, 0, 0 );
# While reading the file in, if you find a line that matches that
+regexp,
# push a reference to an anonymous hash into the array and increme
+nt $count
while( <$input> ) {
++$count if( /\bsub\s*(\w+)\s*{/ and push( @subs, { line => $l
+ine_num,
name => $1
+ } ) );
++$line_num;
}
print "Found $count subroutines\n";
print "Subs are as follows\n";
# Oy-vey!
# 1: print will take a list and print it out, which is handy becau
+se in this
# context, that's exactly what map will return
# 2: map is applying that sprintf to each item in @subs
# 3: @subs contains hash-refs, so all that $%_ nonesense is just
# dereferencing all that
print map sprintf( " %4d: %s\n", ${%$_}{line}, ${%$_}{name} ), @su
+bs;
}
######################################################################
+##########
# count_code( $file )
sub count_code {
my( $input ) = shift;
my $count = 0;
seek( $input, 0, 0 );
while( <$input> ) { ++$count unless( /^$/ or /^\s*$/ or /^\s*#/ );
+ }
print "Found $count LOC\n";
}
######################################################################
+##########
# count_comments( $file )
sub count_comments {
my( $input ) = shift;
my $count = 0;
seek( $input, 0, 0 );
while( <$input> ) { ++$count if( /\s*#/ ); }
print "Found $count comment lines\n";
}
######################################################################
+##########
# count_loops( $file )
sub count_loops {
my( $input ) = shift;
my $count = 0;
my $line_num = 1;
my @loops = ();
seek( $input, 0, 0 );
while( <$input> ) {
++$count if( /(?:while|for|until)\s*\(/ and push( @loops, $lin
+e_num ) );
++$line_num;
}
print "Found ".@loops." loops on lines @loops\n";
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.