File Coverage

blib/lib/Test/Spellunker.pm

Criterion	Covered	Total	%
statement	66	76	86.8
branch	20	30	66.6
condition	3	6	50.0
subroutine	15	15	100.0
pod	5	5	100.0
total	109	132	82.5

package Test::Spellunker;
use strict;
use warnings;
use 5.008001;

use Spellunker::Pod;

use parent qw(Exporter);

use version; our $VERSION = version->declare("v0.4.0");

use Test::Builder;
use File::Spec;

our $SPELLUNKER = Spellunker::Pod->new();

our @EXPORT = qw(
  pod_file_spelling_ok
  all_pod_files_spelling_ok
  add_stopwords
  load_dictionary
);

my $TEST = Test::Builder->new();

sub all_pod_files_spelling_ok {
    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my @files = all_pod_files(@_);

    $TEST->plan(tests => scalar @files);

    my $ok = 1;
    for my $file (@files) {
        pod_file_spelling_ok($file) or undef $ok;
    }
    return $ok;
}

sub _starting_points {
    return 'blib' if -d 'blib';
    return grep -d, qw(bin lib script);
}

sub all_pod_files {
    my @queue = @_ ? @_ : _starting_points();
    my @pod;

    while (@queue) {
        my $file = shift @queue;

        # recurse into subdirectories
        if (-d $file) {
            opendir(my $dirhandle, $file) or next;
            my @newfiles = readdir($dirhandle);
            closedir $dirhandle;

            @newfiles = File::Spec->no_upwards(@newfiles);
            @newfiles = grep { $_ ne "CVS" && $_ ne ".svn" } @newfiles;

            push @queue, map "$file/$_", @newfiles;
        }

        # add the file if it meets our criteria
        if (-f $file) {
            next unless _is_perl($file);
            push @pod, $file;
        }
    }

    return @pod;
}

sub _is_perl {
    my $file = shift;

    return 1 if $file =~ /\.PL$/;
    return 1 if $file =~ /\.p(l|lx|m|od)$/;
    return 1 if $file =~ /\.t$/;

    open my $handle, '<', $file or return;
    my $first = <$handle>;

    return 1 if defined $first && ($first =~ /^#!.*perl/);

    return 0;
}

sub pod_file_spelling_ok {
    my $file = shift;
    my $name = shift || "POD spelling for $file";

    if ( !-r $file ) {
        $TEST->ok( 0, $name );
        $TEST->diag("$file does not exist or is unreadable");
        return;
    }

    my @err = $SPELLUNKER->check_file($file);

    my $ok = @err == 0;
    $TEST->ok($ok, "$name");
    if (!$ok) {
        my $msg = "Errors:\n";
        for (@err) {
            my ($lineno, $line, $errs) = @$_;
            for my $err (@$errs) {
                $msg .= "    $lineno: $err\n";
            }
        }
        $TEST->diag($msg);
    }

    return $ok;
}

sub add_stopwords {
    $SPELLUNKER->add_stopwords(@_);
}

sub load_dictionary {
    $SPELLUNKER->load_dictionary(@_);
}


1;
__END__