Skip to content

Commit f97e4cd

Browse files
oaldersoalders
committed
Make it easier to test Pod outside of Catalyst env.
1 parent 5a755ff commit f97e4cd

File tree

5 files changed

+170
-48
lines changed

5 files changed

+170
-48
lines changed

‎lib/MetaCPAN/Document/File.pm‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@ use Encode;
1111
use List::AllUtils qw( any );
1212
use List::MoreUtils qw(any uniq);
1313
use MetaCPAN::Document::Module;
14-
use MetaCPAN::Pod::XHTML;
1514
use MetaCPAN::Types qw(:all);
1615
use MetaCPAN::Util;
1716
use MooseX::Types::Moose qw(ArrayRef);

‎lib/MetaCPAN/Pod/Renderer.pm‎

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
package MetaCPAN::Pod::Renderer;
2+
3+
use strict;
4+
use warnings;
5+
6+
use Moose;
7+
8+
use MetaCPAN::Pod::XHTML;
9+
use Pod::Markdown;
10+
use Pod::POM;
11+
use Pod::POM::View::Pod;
12+
use Pod::Text;
13+
14+
sub markdown_renderer {
15+
my $self = shift;
16+
return Pod::Markdown->new;
17+
}
18+
19+
sub pod_renderer {
20+
my $self = shift;
21+
return Pod::POM->new;
22+
}
23+
24+
sub text_renderer {
25+
my $self = shift;
26+
return Pod::Text->new( sentence => 0, width => 78 );
27+
}
28+
29+
sub html_renderer {
30+
my $self = shift;
31+
32+
my $parser = MetaCPAN::Pod::XHTML->new;
33+
34+
$parser->html_footer('');
35+
$parser->html_header('');
36+
$parser->index(1);
37+
$parser->no_errata_section(1);
38+
$parser->perldoc_url_prefix('https://metacpan.org/pod/');
39+
40+
return $parser;
41+
}
42+
43+
sub to_markdown {
44+
my $self = shift;
45+
my $source = shift;
46+
47+
return $self->_generic_render( $self->markdown_renderer, $source );
48+
}
49+
50+
sub to_text {
51+
my $self = shift;
52+
my $source = shift;
53+
54+
return $self->_generic_render( $self->text_renderer, $source );
55+
}
56+
57+
sub to_html {
58+
my $self = shift;
59+
my $source = shift;
60+
61+
return $self->_generic_render( $self->html_renderer, $source );
62+
}
63+
64+
sub to_pod {
65+
my $self = shift;
66+
my $source = shift;
67+
68+
my $renderer = $self->pod_renderer;
69+
my $pom = $renderer->parse_text($source);
70+
return Pod::POM::View::Pod->print($pom);
71+
}
72+
73+
sub _generic_render {
74+
my $self = shift;
75+
my $renderer = shift;
76+
my $source = shift;
77+
my $output = q{};
78+
79+
$renderer->output_string( \$output );
80+
$renderer->parse_string_document($source);
81+
82+
return $output;
83+
}
84+
85+
__PACKAGE__->meta->make_immutable();
86+
1;

‎lib/MetaCPAN/Pod/XHTML.pm‎

Lines changed: 1 addition & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ use strict;
44
use warnings;
55

66
# Keep the coding style of Pod::Simple for consistency and performance.
7+
# Pod::Simple::XHTML expects you to subclass and then override methods.
78

89
use parent 'Pod::Simple::XHTML';
910

@@ -26,12 +27,6 @@ sub handle_text {
2627
}
2728
}
2829

29-
sub perldoc_url_prefix {
30-
'https://metacpan.org/pod/';
31-
}
32-
33-
# thanks to Marc Green
34-
3530
sub start_item_text {
3631

3732
# see end_item_text

‎lib/MetaCPAN/Server/View/Pod.pm‎

Lines changed: 21 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -3,18 +3,19 @@ package MetaCPAN::Server::View::Pod;
33
use strict;
44
use warnings;
55

6-
use MetaCPAN::Pod::XHTML;
6+
use MetaCPAN::Pod::Renderer;
77
use Moose;
8-
use Pod::Markdown;
9-
use Pod::POM;
10-
use Pod::Text;
118

129
extends 'Catalyst::View';
1310

1411
sub process {
1512
my ( $self, $c ) = @_;
13+
14+
my $renderer = MetaCPAN::Pod::Renderer->new;
15+
1616
my $content = $c->res->body || $c->stash->{source};
17-
$content = eval { join( "", $content->getlines ) };
17+
$content = eval { join( q{}, $content->getlines ) };
18+
1819
my ( $body, $content_type );
1920
my $accept = eval { $c->req->preferred_content_type } || 'text/html';
2021
my $show_errors = $c->req->params->{show_errors};
@@ -23,63 +24,42 @@ sub process {
2324
$x_codes = $c->config->{pod_html_x_codes} unless defined $x_codes;
2425

2526
if ( $accept eq 'text/plain' ) {
26-
$body = $self->build_pod_txt($content);
27+
$body = $self->_factory->to_txt($content);
2728
$content_type = 'text/plain';
2829
}
2930
elsif ( $accept eq 'text/x-pod' ) {
30-
$body = $self->extract_pod($content);
31+
$body = $self->_factory->to_pod($content);
3132
$content_type = 'text/plain';
3233
}
3334
elsif ( $accept eq 'text/x-markdown' ) {
34-
$body = $self->build_pod_markdown($content);
35+
$body = $self->_factory->to_markdown($content);
3536
$content_type = 'text/plain';
3637
}
3738
else {
3839
$body = $self->build_pod_html( $content, $show_errors, $x_codes );
3940
$content_type = 'text/html';
4041
}
42+
4143
$c->res->content_type($content_type);
4244
$c->res->body($body);
4345
}
4446

45-
sub build_pod_markdown {
46-
my ( $self, $source ) = @_;
47-
my $parser = Pod::Markdown->new;
48-
my $mkdn = q[];
49-
$parser->output_string( \$mkdn );
50-
$parser->parse_string_document($source);
51-
return $mkdn;
52-
}
53-
5447
sub build_pod_html {
5548
my ( $self, $source, $show_errors, $x_codes ) = @_;
56-
my $parser = MetaCPAN::Pod::XHTML->new();
57-
$parser->index(1);
58-
$parser->html_header('');
59-
$parser->html_footer('');
60-
$parser->perldoc_url_prefix('');
61-
$parser->no_errata_section( !$show_errors );
62-
$parser->nix_X_codes( !$x_codes );
63-
my $html = "";
64-
$parser->output_string( \$html );
65-
$parser->parse_string_document($source);
66-
return $html;
67-
}
6849

69-
sub extract_pod {
70-
my ( $self, $source ) = @_;
71-
my $parser = Pod::POM->new;
72-
my $pom = $parser->parse_text($source);
73-
return Pod::POM::View::Pod->print($pom);
50+
my $renderer = $self->_factory->xhtml_renderer;
51+
$renderer->nix_X_codes( !$x_codes );
52+
$renderer->no_errata_section( !$show_errors );
53+
54+
my $html = q{};
55+
$renderer->output_string( \$html );
56+
$renderer->parse_string_document($source);
57+
return $html;
7458
}
7559

76-
sub build_pod_txt {
77-
my ( $self, $source ) = @_;
78-
my $parser = Pod::Text->new( sentence => 0, width => 78 );
79-
my $text = "";
80-
$parser->output_string( \$text );
81-
$parser->parse_string_document($source);
82-
return $text;
60+
sub _factory {
61+
my $self = shift;
62+
return MetaCPAN::Pod::Renderer->new;
8363
}
8464

8565
1;

‎t/pod/renderer.t‎

Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
use strict;
2+
use warnings;
3+
4+
use Test::More;
5+
6+
use MetaCPAN::Pod::Renderer;
7+
8+
my $factory = MetaCPAN::Pod::Renderer->new();
9+
my $html_renderer = $factory->html_renderer;
10+
$html_renderer->index(0);
11+
12+
my $got = q{};
13+
14+
my $source = <<'EOF';
15+
=pod
16+
17+
=head1 DESCRIPTION
18+
L<Plack>
19+
=cut
20+
EOF
21+
22+
{
23+
my $html = <<'EOF';
24+
<h1 id="DESCRIPTION-Plack">DESCRIPTION <a href="https://metacpan.org/pod/Plack">Plack</a></h1>
25+
26+
EOF
27+
28+
$html_renderer->output_string( \$got );
29+
$html_renderer->parse_string_document($source);
30+
is( $got, $html, 'XHTML linkifies to metacpan by default' );
31+
}
32+
33+
{
34+
my $md = <<'EOF';
35+
# DESCRIPTION
36+
[Plack](https://metacpan.org/pod/Plack)
37+
EOF
38+
39+
is( $factory->to_markdown($source), $md, 'markdown' );
40+
}
41+
42+
{
43+
my $text = <<'EOF';
44+
DESCRIPTION
45+
Plack
46+
EOF
47+
48+
is( $factory->to_text($source), $text, 'text' );
49+
}
50+
51+
{
52+
my $pod = <<'EOF';
53+
=head1 DESCRIPTION
54+
L<Plack>
55+
=cut
56+
57+
58+
EOF
59+
60+
is( $factory->to_pod($source), $pod, 'pod' );
61+
}
62+
done_testing();

0 commit comments

Comments
 (0)