#!/usr/bin/perl -w use strict; my $total_lines = 0; # Contains the total number of lines in all the files supplied. my $logical_lines = 0; # Contains the number of logical lines of code in one file. my $in_pod = 0; # If set to 1, indicates that we are currently in the middle of # a POD comment and hence shouldn't be counting lines of code. # If the first argument specified on the command-line is '-v', we want verbose output. my $verbose = 0; my $first_arg = $ARGV[0]; if ($first_arg eq "-v") { shift @ARGV; # Remove the first element of the @ARGV array. $verbose = 1; } # For each of the filenames supplied on the command-line, execute the following block, # which will count up the logical lines in that file. foreach my $file (@ARGV) { # Re-initialize variables to zero. $logical_lines = 0; $in_pod = 0; # Open the file for reading. Die if there is some kind of error. open(FILE, $file) or die "Could not open $file: $!"; # Process each of the lines of the file, in sequence. foreach () { # A line beginning with '=cut' marks the end of a POD block. reject($_), $in_pod = 0, next if /^=cut/i; # If we are in a POD block, this is not a line of code. reject($_), next if $in_pod; # A line beginning with the '=' character marks the beginning of a POD block. reject($_), $in_pod = 1, next if /^=/i; # A line containing no alphanumerics is not counted as a line of code. reject($_), next unless /\w/; # A line beginning with whitespace and followed by a pound character is a comment. reject($_), next if /^\s*#/; # If we got here, this line is actually a line of code. acknowledge($_); } # Close the file. close(FILE); # Print the results for this file and add to $total_lines. print "$file contains $logical_lines logical lines of code.\n"; $total_lines += $logical_lines; } # Print the final result. print "$total_lines logical lines of code in ", scalar(@ARGV), " files.\n"; # The function that gets called whenever we determine that # the current line is a logical line of code. sub acknowledge { my $line = shift; $logical_lines++; print "+ $line" if $verbose; } # The function that gets called whenever we determine that # the current line isn't a logical line of code. sub reject { my $line = shift; print "- $line" if $verbose; }