http://qs321.pair.com?node_id=58471
Category: Text Processing
Author/Contact Info David Olbersen dave@slickness.org
Description: This lil app will give you the following info about your Perl source files
  • Number of subroutines (and their line number)
  • Number of loops (and their line number)
  • Number of lines that are actual code
  • Number of lines that are just comments
#!/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";
}