lib/Frey/Pod.pm

package Frey::Pod;
use Moose;

=head1 NAME

Frey::Pod - display documentation

=cut

extends 'Frey::ClassLoader';
with 'Frey::Web';

has 'class' => (
        is => 'rw',
        isa => 'Str',
        required => 1,
);

use File::Slurp;
use Data::Dump qw/dump/;

sub request {
        my ( $self, $req ) = @_;
        my $f = { $req->params };
        my $class = delete( $f->{class} ) || $self->class;
        $req->print( $self->page( title => $class, body => $self->markup( $class ) ) );
}

sub markup {
        my $self = shift;
        my $class = $self->class;
        use Pod::Simple::HTML;
        my $path = eval { $self->class_path( $class ) };
        if ( $@ ) {
                warn $@;
                my $error = $@;
                $error =~ s{\s+(\S+)\s+line\s+(\d+)}{ <a href="/editor$1+$2" target="editor">$1</a> line $2}gsm;
                return qq|<div class="error"><pre>$error</pre></div>|;
        }
        my $pod = read_file( $path );
        my $converter = Pod::Simple::HTML->new();
        my $body;
        my $my_classes = join('|', $self->classes);
        $converter->output_string( \$body );
        $converter->parse_string_document($pod);
        $body =~ s{.*?<body [^>]+>}{}s;
        $body =~ s{</body>\s*</html>\s*$}{};
        $body =~ s!%3A%3A!::!g;
        $body =~ s{<a href="http://search\.cpan\.org/perldoc\?($my_classes)"([^>]*)>}{<a href="/$1"$2>}g;
        $body =~ s{<a href="http://(search\.cpan\.org)/([^"]+)"([^>]*)>}{<a target="$1" href="http://$1/$2"$3>}g;
        $body =~ s!</li>\n\t<ul>!<ul>!;
        $body =~ s!</ul>!</ul></li>!;
        $body =~ s!<p></p>!!;
        $body =~ s!__index__!index!g;
        return $body;
}

1;

1	package Frey::Pod;
2	use Moose;
3
4	=head1 NAME
5
6	Frey::Pod - display documentation
7
8	=cut
9
10	extends 'Frey::ClassLoader';
11	with 'Frey::Web';
12
13	has 'class' => (
14	is => 'rw',
15	isa => 'Str',
16	required => 1,
17	);
18
19	use File::Slurp;
20	use Data::Dump qw/dump/;
21
22	sub request {
23	my ( $self, $req ) = @_;
24	my $f = { $req->params };
25	my $class = delete( $f->{class} ) \|\| $self->class;
26	$req->print( $self->page( title => $class, body => $self->markup( $class ) ) );
27	}
28
29	sub markup {
30	my $self = shift;
31	my $class = $self->class;
32	use Pod::Simple::HTML;
33	my $path = eval { $self->class_path( $class ) };
34	if ( $@ ) {
35	warn $@;
36	my $error = $@;
37	$error =~ s{\s+(\S+)\s+line\s+(\d+)}{ <a href="/editor$1+$2" target="editor">$1</a> line $2}gsm;
38	return qq\|<div class="error"><pre>$error</pre></div>\|;
39	}
40	my $pod = read_file( $path );
41	my $converter = Pod::Simple::HTML->new();
42	my $body;
43	my $my_classes = join('\|', $self->classes);
44	$converter->output_string( \$body );
45	$converter->parse_string_document($pod);
46	$body =~ s{.*?<body [^>]+>}{}s;
47	$body =~ s{</body>\s</html>\s$}{};
48	$body =~ s!%3A%3A!::!g;
49	$body =~ s{<a href="http://search\.cpan\.org/perldoc\?($my_classes)"([^>]*)>}{<a href="/$1"$2>}g;
50	$body =~ s{<a href="http://(search\.cpan\.org)/([^"]+)"([^>]*)>}{<a target="$1" href="http://$1/$2"$3>}g;
51	$body =~ s!</li>\n\t<ul>!<ul>!;
52	$body =~ s!</ul>!</ul></li>!;
53	$body =~ s!<p></p>!!;
54	$body =~ s!__index__!index!g;
55	return $body;
56	}
57
58	1;
59