File Coverage

blib/lib/MojoMojo/Formatter/Pod.pm

Criterion	Covered	Total	%
statement	49	52	94.2
branch	8	12	66.6
condition	1	6	16.6
subroutine	11	11	100.0
pod	3	3	100.0
total	72	84	85.7

package MojoMojo::Formatter::Pod;

use parent qw/MojoMojo::Formatter/;
# Pod::Simple::HTML gives warnings for version_tag_comment()
# because $self->VERSION is empty in the sprintf.  We don't
# really care about this sub do we?  It's been monkey zapped.
BEGIN
{
    use Pod::Simple::HTML;
    no warnings 'redefine';
    *{"Pod::Simple::HTML::version_tag_comment"} = sub {
        my $self = shift;
        return;
    }
}


=head1 NAME

MojoMojo::Formatter::Pod - format part of content as POD

=head1 DESCRIPTION

This formatter will format content between {{pod}} and {{end}} as
POD (Plain Old Documentation).

=head1 METHODS

=head2 format_content_order

Format order can be 1-99. The POD formatter runs on 10.

=cut

sub format_content_order { 10 }

=head2 format_content

calls the formatter. Takes a ref to the content as well as the
context object.

=cut

sub format_content {
    my ( $class, $content, $c ) = @_;

    my @lines = split /\n/, $$content;
    my $pod;
    $$content = "";
    my $start_re=$class->gen_re(qr/pod/);
    my $end_re=$class->gen_re(qr/end/);
    foreach my $line (@lines) {
        if ($pod) {
            if ( $line =~ m/^(.*)$end_re(.*)$/ ) {
                $$content .= MojoMojo::Formatter::Pod->to_pod( $pod.$1, $c->req->base ).$2;
                $pod = "";
            }
            else { $pod .= $line . "\n"; }
        }
        else {
            if ( $line =~ m/^(.*)$start_re(.*)$/ ) {
                $$content .= $1;
                $pod = " ".$2;    # make it true :)
            }
            else { $$content .= $line . "\n"; }
        }
    }
}

=head2 to_pod <pod> <base>

Takes some POD documentation, a base URL, and renders it as HTML.

=cut

sub to_pod {
    my ( $class, $pod, $base ) = @_;
    my $result;
    my $parser = MojoMojo::Formatter::Pod::Simple::HTML->new($base);
    $parser->output_string( \$result );
    eval { $parser->parse_string_document($pod); };
    return "<pre>\n$source\n$@\n</pre>\n"
        if $@ or not $result;
    $result =~ s/.*<body.*?>(.*)<\/body>.*/$1/s;
    return qq{<div class="formatter_pod">\n$result</div>};
}

package MojoMojo::Formatter::Pod::Simple::HTML;

# base class for doing links

use parent 'Pod::Simple::HTML';

=head2 Pod::Simple::HTML::new

Extended for setting C<base>.

=cut

sub new {
    my ( $class, $base ) = @_;
    my $self = $class->SUPER::new;
    $self->{_base} = $base;
    return $self;
}

=head2 Pod::Simple::HTML::do_link

Set links based on base

=cut

sub do_link {
    my ( $self, $token ) = @_;
    my $link = $token->attr('to');

    #FIXME: This doesn't look right:
    return $self->SUPER::do_link($token) unless $link =~ /^$token+$/;
    my $section = $token->attr('section');
    $section = "#$section"
        if defined $section and length $section;
    $self->{base} . "$link$section";
}

=head1 SEE ALSO

L<MojoMojo>, L<Module::Pluggable::Ordered>, L<POD::Tree::HTML>

=head1 AUTHORS

Marcus Ramberg <[e-mail]>

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;