Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Perl Source Stats

by spaz (Pilgrim)
on Feb 15, 2001 at 01:42 UTC ( [id://58471]=sourcecode: print w/replies, xml ) Need Help??
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";
}
Replies are listed 'Best First'.
(ichimunki) Basic design seems inefficient
by ichimunki (Priest) on Feb 15, 2001 at 04:16 UTC
    Can you explain your decision to not only loop over the same data set several times, but to actually read it in from the file separately for each pass?
      Rare is the Perl source that can't fit in memory.    my @source = <IN>; will do the trick, and give you something to iterate over in your subroutines.
      Simple!
      I'm a rank amature!

      Actually, I was thinking that at some point I might try to make this a little more robust, so that it could rewind and fast-forward. The purpose being to tell you how long each sub routine is, for example.

      -- Dave

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://58471]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (4)
As of 2024-04-19 23:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found