use Perl

Long ago, when I started on this code base that my department now watches over, I wrote a utility called fluff, akin to lint, which would look for naughty constructs in code. I think it originally would look for things like single-character variable names that weren't $i or $n.

It's grown and evolved over time. Now we add things like using modules that we've out grown (CGI.pm, Array::Iterator), or using a no_plan in our tests. Plus, last night I made it so that you can select what you want to fluff on from the command line.

fluff [options] [files]
    --array-iterator  using Array::Iterator
    --commented       Commented-out code
    --croak           Croak, should probably be an assertion
    --data            Variables called "data"
    --dumper          Data dumper diagnostics
    --else-one-line   else and result on one line
    --if-one-line     if and result on one line
    --mech-ok         Using ok() for mech content instead of $mech->content_like
    --no_plan         no_plan
    --oci             OCI calls
    --pathing         Up-n-over pathing
    --ref-proto       ref proto || proto
    --return-undef    Returning undef
    --review          REVIEWed things to be addressed later
    --sqldo           sqldo using vars, not binds
    --todo            TODOed things to be addressed later
    --ttml            Calling TT process on a .tt file (not .ttml)
    --using           using CGI.pm
    --xxx             XXXed things to be addressed later

Here's the code if anyone wants to steal, or have any suggestions.

#!/usr/bin/perl -w

use strict;
use File::Find;
use Data::Hash::Totals;
use List::Util qw( max );
use Getopt::Long;

=head1 TODO

All .ttml files should be twcollapsed

=cut

my %getopt_options = ( help => sub{ help(); exit; } );
my %checks;

for my $opt ( possible_errors() ) {
    my $tag  = $opt->[0];
    $getopt_options{$tag} = eval qq/ sub { \$checks{"$tag"} = 1 } /;
}

GetOptions( %getopt_options ) or exit 1;

# Set all options on if none are explicitly set
if ( !%checks ) {
    %checks = map {($_->[0],1)} possible_errors();
}

my %errors;
if ( @ARGV ) {
    process_file($_) for @ARGV;
} else {
    find( \&handler, "." );
}

my %totals;
my $nerrors = 0;
for my $pe ( possible_errors() ) {
    $totals{$pe->[1]} = 0 if $checks{ $pe->[0] };
}

for my $errstr ( sort keys %errors ) {
    print "$errstr\n";
    my @errors = @{$errors{$errstr}};
    print "    $_\n" for @errors;
    print "\n";
    $totals{$errstr} = @errors;
    $nerrors += @errors;
}

print as_table( \%totals );
printf( "%4d Total\n", $nerrors );

sub handler {
    if ( -d ) {
        $File::Find::prune = 1 if /\b(\.svn|CVS)\b/;
        return;
    }
    return unless /\.(css|tt|ttml|t|pm|php|phpt|html)$/;

    process_file( $_, $File::Find::name );
}

sub process_file {
    my $filename = shift;
    my $displayname = shift || $filename;

    open( my $fh, $filename ) or die "Can't open $filename: $!";
    my @checks = grep { $checks{$_->[0]} } possible_errors();
    while ( my $line = <$fh> ) {
        for ( @checks ) {
            my ($tag,$desc,$finder) = @$_;
            if ( $line =~ $finder ) {
                chomp $line;
                push( @{$errors{$desc}}, "$displayname($.): $line" );
            }
        } # for
    } # while
    close $fh;
} # process_file()

sub help {
    print "fluff [options] [files]\n";

    my @pe = possible_errors();
    @pe = sort { $a->[0] cmp $b->[0] } @pe;
    my $max = max map { length $_->[0] } @pe;

    for my $opt ( @pe ) {
        my ($tag,$desc) = @$opt;
        printf( "    --%-*s  %s\n", $max, $tag, $desc );
    }
}

sub possible_errors {
return (
[
xxx =>
    "XXXed things to be addressed later" =>
    qr/\bXXX\b/
],
[
todo =>
    "TODOed things to be addressed later" =>
    qr/TODO/
],
[
review =>
    "REVIEWed things to be addressed later" =>
    qr/\bREVIEW\b/
],
[
no_plan =>
    "no_plan" =>
    qr/\bno_plan\b/
],
[
commented =>
    "Commented-out code" =>
    qr/^\s*#.*\$.*=/
],
[
'return-undef' =>
    "Returning undef" =>
    qr/return\s+undef/
],
[
data =>
    'Variables called "data"' =>
    qr/[\$\%\@]data\d*\b/
],
[
pathing =>
    'Up-n-over pathing' =>
    qr/\.\.\//
],
[
'ref-proto' =>
    'ref proto || proto' =>
    qr/ref\b.+\$\w+.*\|\|.*\$\w+/
],
[
'mech-ok' =>
    'Using ok() for mech content instead of $mech->content_like' =>
    qr/^\s*ok.*>content/
],
[
croak =>
    'Croak, should probably be an assertion' =>
    qr/croak\(/
],
[
dumper =>
    'Data dumper diagnostics' =>
    qr/warn\s+Dumper/
],
[
ttml =>
    'Calling TT process on a .tt file (not .ttml)' =>
    qr/process\(.*\.tt[^m]/
],
[
'array-iterator' =>
    'using Array::Iterator' =>
    qr/Array::Iterator/
],
[
oci =>
    'OCI calls' =>
    qr/OCI\w+\(/
],
[
'if-one-line' =>
    'if and result on one line' =>
    qr/\b(if|elsif|elseif)\b\s*\(.+\)\s*{.+}/
],
[
'else-one-line' =>
    'else and result on one line' =>
    qr/\belse\b\s*{.+}/
],
[
using =>
    'using CGI.pm' =>
    qr/use CGI[^:]/
],
[
sqldo =>
    'sqldo using vars, not binds' =>
    qr/sqldo.+=\s*'?\$\w+/
],
);
}