File Coverage

blib/lib/Test/EOF.pm

Criterion	Covered	Total	%
statement	74	100	74.0
branch	26	54	48.1
condition	4	11	36.3
subroutine	15	16	93.7
pod	1	2	50.0
total	120	183	65.5

use 5.10.1;
use strict;
use warnings;

package Test::EOF;

our $VERSION = '0.0802'; # VERSION
# ABSTRACT: Check correct end of files in a project.

use Cwd qw/cwd/;
use File::Find;
use File::ReadBackwards;
use Test::Builder;

my $perlstart = qr/^#!.*perl/;
my $test = Test::Builder->new;

sub import {
    my $self = shift;
    my $caller = caller;
    {
        no strict 'refs';
        *{ $caller.'::all_perl_files_ok'} = \&all_perl_files_ok;
    }
    $test->exported_to($caller);
    $test->plan(@_);
}

sub all_perl_files_ok {
    my $options = ref $_[0] eq 'HASH' ? shift : ref $_[-1] eq 'HASH' ? pop : {};
    my @files = _all_perl_files(@_);

    $test->expected_tests;

    # no need to check then...
    if(exists $options->{'minimum_newlines'} && $options->{'minimum_newlines'} <= 0) {
        return 1;
    }

    foreach my $file (@files) {
        _check_perl_file($file, $options);
    }
}

sub _check_perl_file {
    my $file = shift;
    my $options = shift;

    $options->{'minimum_newlines'} ||= 1;
    if(!exists $options->{'maximum_newlines'}) {
        $options->{'maximum_newlines'} = $options->{'minimum_newlines'} + 3;
    }
    elsif(exists $options->{'maximum_newlines'} && $options->{'maximum_newlines'} < $options->{'minimum_newlines'}) {
        $options->{'maximum_newlines'} = $options->{'minimum_newlines'};
    }

    if($options->{'strict'}) {
        $options->{'minimum_newlines'} = 1;
        $options->{'maximum_newlines'} = 1;
    }

    $file = _module_to_path($file);

    my $reader = File::ReadBackwards->new($file) or return;

    my $linecount = 0;

    LINE:
    while(my $line = $reader->readline) {
        ++$linecount if $line =~ m{\v$};
        next LINE if $line =~ m{^\v$};
        last LINE;
    }

    if($linecount < $options->{'minimum_newlines'}) {
        my $wanted = make_wanted($options);
        $test->ok(0, "Not enough line breaks (had $linecount, wanted $wanted) at the end of $file");
        return 0;
    }
    elsif($linecount > $options->{'maximum_newlines'}) {
        my $wanted = make_wanted($options);
        $test->ok(0, "Too many line breaks (had $linecount, wanted $wanted) at the end of $file ");
        return 0;
    }
    $test->ok(1, "Just the right number of line breaks at the end of $file");
    return 1;

}

sub make_wanted {
    my $options = shift;
    return $options->{'minimum_newlines'} if $options->{'minimum_newlines'} == $options->{'maximum_newlines'};
    return sprintf "%d to %d" => $options->{'minimum_newlines'}, $options->{'maximum_newlines'};
}

sub _all_perl_files {
    my @base_dirs = @_ ? @_ : cwd();
    my @found;

    my $wants = sub {
        return if $File::Find::dir =~ m{ [\\/]? (?:CVS|\.svn) [\\/] }x;
        return if $File::Find::dir =~ m{ [\\/]? blib [\\/] (?: libdoc | man\d) $  }x;
        return if $File::Find::dir =~ m{ [\\/]? inc }x;
        return if $File::Find::name =~ m{ Build $ }xi;
        return unless -f -r $File::Find::name;
        push @found => File::Spec->no_upwards($File::Find::name);
    };
    my $find_arg = {
        wanted => $wants,
        no_chdir => 1,
    };

    find($find_arg, @base_dirs);

    my @perls = grep { _is_perl($_) || _is_perl($_) } @found;

    return @perls;
}

sub _is_perl {
    my $file = shift;

    # module
    return 1 if $file =~ m{\.pm$}i;
    return 1 if $file =~ m{::};

    # script
    return 1 if $file =~ m{\.pl}i;
    return 1 if $file =~ m{\.t$};

    open my $fh, '<', $file or return;
    my $first = <$fh>;
    if(defined $first && $first =~ $perlstart) {
        close $fh;
        return 1;
    }

    # nope
    return;
}

sub _module_to_path {
    my $file = shift;
    return $file unless $file =~ m{::};
    my @parts = split /::/ => $file;
    my $module = File::Spec->catfile(@parts) . '.pm';

    CANDIDATE:
    foreach my $dir (@INC) {
        my $candidate = File::Spec->catfile($dir, $module);
        next CANDIDATE if !-e -f -r $candidate;
        return $candidate;
    }
    return $file;
}

1;

__END__