File Coverage

blib/lib/Test/Pod/Content.pm

Criterion	Covered	Total	%
statement	74	78	94.8
branch	21	30	70.0
condition			n/a
subroutine	14	14	100.0
pod	2	2	100.0
total	111	124	89.5

package Test::Pod::Content;
use strict;
use warnings;
use base qw(Pod::Simple Test::More);
use Exporter;
use version; our $VERSION = qv('0.0.6');

our @EXPORT = qw(pod_section_is pod_section_like);

# Globals for running a simple state machine
my $_state = q{};
my $_section = q{};
my $_content = q{};
my $_test_content_sub;

# cleanup everything once we've run our test
sub _reset {
    my $parser = shift;
    $_state = q{};
    $_section = q{};
    $_content = q{};

    # source_dead is not reliable - just die to force terminating the
    # parser run
    $parser->source_dead(1);
    die "OK\n";
}

sub pod_section_is {
    my ($name, $section, $content, $comment ) = @_;

    my $found = 0;

    $_test_content_sub = sub {
        my ($parser, $section_name, $test_content) = @_;
        if ($section_name eq $section) {
            $found++;
            Test::More::is($test_content, $content, $comment);
            _reset($parser);
        }
    };

    eval { Test::Pod::Content->filter( _find_file($name) ) };
    if ($@) { die $@ if ($@ !~m{^OK\n$}xm) };

    if (not $found) {
        Test::More::fail $comment;
    }
    return;
}

sub pod_section_like {
    my ($name, $section, $regex, $comment ) = @_;

    my $found = 0;

    $_test_content_sub = sub {
        my ($parser, $section_name, $test_content) = @_;
        if ($section_name eq $section) {
            $found++;
            Test::More::like($test_content, $regex, $comment);
            _reset($parser);
        }
    };

    eval { Test::Pod::Content->filter( _find_file($name) ) };
    if ($@) { die $@ if ($@ !~m{^OK\n$}xm) };

    if (not $found) {
        Test::More::fail $comment;
    }
    return;
}

sub _find_file {
    my $name = shift;
    return $name if (-e $name);
    for my $path (@INC) {
        return "$path/$name" if -e "$path/$name";
    }
    $name =~s{::}{/}xmg;
    $name .= '.pm';
    for my $path (@INC) {
        return "$path/$name" if -e "$path/$name";
    }
    return;
}

sub _handle_element_start {
    my($parser, $element_name, $attr_hash_r) = @_;
    # print "START $element_name\n";
    if ($element_name =~m{^head\d$}xm) {
        # Test last section's content on every new section
        $_test_content_sub->($parser, $_section, $_content);
        $_state = 'section';
        $_content = q{};
    }
    return;
}

sub _handle_element_end {
    my($parser, $element_name) = @_;
    # print "END $element_name\n";
    if ($element_name =~m{^Document$}xm) {
        $_test_content_sub->($parser, $_section, $_content);
    }
    return;
}

sub _handle_text {
    my($parser, $text) = @_;
    # print "TEXT $text\n";
    if ($_state eq 'section') {
        $_section = $text;
        $_state = 'section_content_start';
        return;
    }
    if ($_state eq 'section_content_start') {
        $_content .= $text;
    }
    return;
}


1;

__END__