libtest-pod-content-perl 0.0.6-2 / usr / share / perl5 / Test / Pod / Content.pm

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__

=pod

=head1 NAME

Test::Pod::Content - Test a Pod's content

=head1 SYNOPSIS

 use Test::Pod::Content tests => 3;
 pod_section_is 'Test::Pod::Content' , 'NAME', "Test::Pod::Content - Test a Pod's content", 'NAME section';
 pod_section_like 'Test/Pod/Content.pm', 'SYNOPSIS', qr{ use \s Test::Pod::Content; }xm, 'SYNOPSIS section';
 pod_section_like 'Test/Pod/Content.pm', 'DESCRIPTION', qr{ Test::Pod::Content \s provides \s the }xm, 'DESCRIPTION section';

=head1 DESCRIPTION

This is a very simple module for testing a Pod's content. It is mainly
intended for testing the content of generated Pod - that is, the Pod included
in perl modules generated by some mechanism.

Another usage example is to test whether all files contain the same copyright
notice:

=for test

 plan tests => scalar @filelist;

 for my $file (sort @filelist) {
    pod_section_like( $file, 'LICENSE AND COPYRIGHT', qr{
        This \s library \s is \s free \s software\. \s
        You \s may \s distribute/modify \s it \s under \s
        the \s same \s terms \s as \s perl \s itself
    }xms, "$file License notice");
 }

See the files in the t/ directory for live examples.

Test::Pod::Content has a very simple concept of Pods: To Test::Pod::Content, a
Pod is separated into section. Each section starts with a =head(1|2|3|4)
directive, and ends with the next =head, or with the end of the document
(=cut).

This is a very drastic simplification of Pod's document object model, and only
allows for coarse-grained tests.

Test::Pod::Content provides the following subroutines for testing a Pod's content:

=head1 SUBROUTINES/METHODS

=head2 pod_section_is

  pod_section_is $file, $section, $content, $comment;

Tests whether a Pod section contains exactly the text given. Most useful
for testing the NAME section. You probably want to use pod_section_like
for all other sections.

$file may either be a filename (including path) or a module name.
Test::Pod::Content will search in @INC for the file/module given.

=head2 pod_section_like

 pod_section_like $file, $section, qr{ use \s Test::Pod::Content\s }xm, $comment;

Tests whether the text in a Pod section matches the given regex. Be sure to
include the m / s regex qualifier if you expect your Pod section to span
multiple lines.

$file may either be a filename (including path) or a module name.
Test::Pod::Content will search in @INC for the file/module given.

=head1 BUGS AND LIMITATIONS

=over

=item * Performance

Every call to a pod_section_* method searches for the file in question in
@INC and parses it from its start. This means that every test requires
a Pod parser run, which is quite inefficient if you conduct a big number of
tests.

=item * Pod Syntax

Test::Pod::Coverage may report wrong test results if your pod is not
syntactically correct. You should use L<Test::Pod|Test::Pod> to check your
Pod's syntax.

=back

=head1 DEPENDENCIES

L<Test::More|Test::More>

L<Pod::Simple|Pod::Simple>

L<version|version>

=head1 INCOMPATIBILITIES

None known

=head1 SEE ALSO

L<Test::Pod|Test::Pod> for testing your POD's validity

L<Test::Pod::Coverage|Test::Pod::Coverage> for checking wether your pod is
complete

L<Pod::Tests|Pod::Tests>, L<Test::Pod::Snippets|Test::Pod::Snippets> and
L<Pod::Snippets|Pod::Snippets> for extracting and executing tests from a POD
(If you plan doing so, here's a little brain-train: Which of the
tests in this module's L</SYNOPSIS> section would fail if you extracted and
executed it?).

=head1 LICENSE AND COPYRIGHT

Copyright 2007 Martin Kutter.

This library is free software. You may distribute/modify it under
the same terms as perl itself

=head1 AUTHOR

Martin Kutter E<lt>martin.kutter fen-net.deE<gt>

=head1 REPOSITORY INFORMATION

 $Id: Content.pm 505 2008-06-22 09:54:54Z kutterma $
 $Revision: 505 $
 $Source: a $
 $Date: 2008-06-22 11:54:54 +0200 (So, 22 Jun 2008) $
 $HeadURL: http://svn.hyper-framework.org/Hyper/Test-Pod-Content/trunk/lib/Test/Pod/Content.pm $

=cut