File Coverage

blib/lib/Mojolicious/Plugin/PODRenderer.pm
Criterion Covered Total %
statement 44 82 53.6
branch 4 20 20.0
condition 2 13 15.3
subroutine 12 17 70.5
pod 1 1 100.0
total 63 133 47.3


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::PODRenderer;
2 1     1   484 use Mojo::Base 'Mojolicious::Plugin';
  1         2  
  1         4  
3              
4 1     1   133 use Mojo::Asset::File;
  1         2  
  1         9  
5 1     1   32 use Mojo::ByteStream;
  1         2  
  1         30  
6 1     1   5 use Mojo::DOM;
  1         1  
  1         28  
7 1     1   5 use Mojo::File 'path';
  1         1  
  1         35  
8 1     1   11 use Mojo::URL;
  1         2  
  1         7  
9             #~ use Mojo::Util 'deprecated';
10 1     1   484 use Pod::Simple::XHTML;
  1         9710  
  1         33  
11 1     1   534 use Pod::Simple::Search;
  1         4933  
  1         873  
12              
13             sub register {
14 1     1 1 49 my ($self, $app, $conf) = @_;
15              
16             #~ deprecated 'Mojolicious::Plugin::PODRenderer is DEPRECATED';
17              
18 1   50     7 my $preprocess = $conf->{preprocess} || 'ep';
19             $app->renderer->add_handler(
20             $conf->{name} || 'pod' => sub {
21 0     0   0 my ($renderer, $c, $output, $options) = @_;
22 0         0 $renderer->handlers->{$preprocess}($renderer, $c, $output, $options);
23 0 0       0 $$output = _pod_to_html($$output) if defined $$output;
24             }
25 1   50     5 );
26              
27             $app->helper(
28 1     1   30 pod_to_html => sub { shift; Mojo::ByteStream->new(_pod_to_html(@_)) });
  1         11  
  1         4  
29              
30             # Perldoc browser
31 1 50       121 return undef if $conf->{no_perldoc};
32 0         0 my $defaults = {module => 'Mojolicious/Guides'};
33 0         0 return $app->routes->any(
34             '/perldoc/:module' => $defaults => [module => qr/[^.]+/] => \&_perldoc);
35             }
36              
37             sub _indentation {
38 16     16   42843 (sort map {/^(\s+)/} @{shift()})[0];
  64         173  
  16         29  
39             }
40              
41             sub _html {
42 0     0   0 my ($c, $src) = @_;
43              
44             # Rewrite links
45 0         0 my $dom = Mojo::DOM->new(_pod_to_html($src));
46 0         0 my $perldoc = $c->url_for('/perldoc/');
47             $_->{href} =~ s!^https://metacpan\.org/pod/!$perldoc!
48             and $_->{href} =~ s!::!/!gi
49 0   0     0 for $dom->find('a[href]')->map('attr')->each;
50              
51             # Rewrite code blocks for syntax highlighting and correct indentation
52 0         0 for my $e ($dom->find('pre > code')->each) {
53 0 0       0 next if (my $str = $e->content) =~ /^\s*(?:\$|Usage:)\s+/m;
54 0 0       0 next unless $str =~ /[\$\@\%]\w|->\w|^use\s+\w/m;
55 0         0 my $attrs = $e->attr;
56 0         0 my $class = $attrs->{class};
57 0 0       0 $attrs->{class} = defined $class ? "$class prettyprint" : 'prettyprint';
58             }
59              
60             # Rewrite headers
61 0         0 my $toc = Mojo::URL->new->fragment('toc');
62 0         0 my @parts;
63 0         0 for my $e ($dom->find('h1, h2, h3, h4')->each) {
64              
65 0 0 0     0 push @parts, [] if $e->tag eq 'h1' || !@parts;
66 0         0 my $link = Mojo::URL->new->fragment($e->{id});
67 0         0 push @{$parts[-1]}, my $text = $e->all_text, $link;
  0         0  
68 0         0 my $permalink = $c->link_to('#' => $link, class => 'permalink');
69 0         0 $e->content($permalink . $c->link_to($text => $toc));
70             }
71              
72             # Try to find a title
73 0         0 my $title = 'Perldoc';
74 0     0   0 $dom->find('h1 + p')->first(sub { $title = shift->text });
  0         0  
75              
76             # Combine everything to a proper response
77 0         0 $c->content_for(perldoc => "$dom");
78 0         0 $c->render('mojo/perldoc', title => $title, parts => \@parts);
79             }
80              
81             sub _perldoc {
82 0     0   0 my $c = shift;
83              
84             # Find module or redirect to CPAN
85 0         0 my $module = join '::', split('/', $c->param('module'));
86 0         0 $c->stash(cpan => "https://metacpan.org/pod/$module");
87             my $path
88 0         0 = Pod::Simple::Search->new->find($module, map { $_, "$_/pods" } @INC);
  0         0  
89 0 0 0     0 return $c->redirect_to($c->stash('cpan')) unless $path && -r $path;
90              
91 0         0 my $src = path($path)->slurp;
92 0     0   0 $c->respond_to(txt => {data => $src}, html => sub { _html($c, $src) });
  0         0  
93             }
94              
95             sub _pod_to_html {
96 1 50   1   6 return '' unless defined(my $pod = ref $_[0] eq 'CODE' ? shift->() : shift);
    50          
97              
98 1         10 my $parser = Pod::Simple::XHTML->new;
99 1         127 $parser->perldoc_url_prefix('https://metacpan.org/pod/');
100 1         9 $parser->$_('') for qw(html_header html_footer);
101 1         15 $parser->strip_verbatim_indent(\&_indentation);
102 1         10 $parser->output_string(\(my $output));
103 1 50       942 return $@ unless eval { $parser->parse_string_document("$pod"); 1 };
  1         12  
  1         6005  
104              
105 1         65 return $output;
106             }
107              
108             1;
109              
110             =encoding utf8
111              
112             =head1 NAME
113              
114             Mojolicious::Plugin::PODRenderer - POD renderer plugin
115              
116             =head1 SYNOPSIS
117              
118             # Mojolicious (with documentation browser under "/perldoc")
119             my $route = $app->plugin('PODRenderer');
120             my $route = $app->plugin(PODRenderer => {name => 'foo'});
121             my $route = $app->plugin(PODRenderer => {preprocess => 'epl'});
122            
123             # Mojolicious::Lite (with documentation browser under "/perldoc")
124             my $route = plugin 'PODRenderer';
125             my $route = plugin PODRenderer => {name => 'foo'};
126             my $route = plugin PODRenderer => {preprocess => 'epl'};
127            
128             # Without documentation browser
129             plugin PODRenderer => {no_perldoc => 1};
130            
131             # foo.html.ep
132             %= pod_to_html "=head1 TEST\n\nC<123>"
133            
134             # foo.html.pod
135             =head1 <%= uc 'test' %>
136              
137             =head1 DESCRIPTION
138              
139             L is a renderer for true Perl hackers, rawr!
140              
141             The code of this plugin is a good example for learning to build new plugins,
142             you're welcome to fork it.
143              
144             See L for a list of plugins that are available
145             by default.
146              
147             =head1 OPTIONS
148              
149             L supports the following options.
150              
151             =head2 name
152              
153             # Mojolicious::Lite
154             plugin PODRenderer => {name => 'foo'};
155              
156             Handler name, defaults to C.
157              
158             =head2 no_perldoc
159              
160             # Mojolicious::Lite
161             plugin PODRenderer => {no_perldoc => 1};
162              
163             Disable L documentation browser that will otherwise be
164             available under C.
165              
166             =head2 preprocess
167              
168             # Mojolicious::Lite
169             plugin PODRenderer => {preprocess => 'epl'};
170              
171             Name of handler used to preprocess POD, defaults to C.
172              
173             =head1 HELPERS
174              
175             L implements the following helpers.
176              
177             =head2 pod_to_html
178              
179             %= pod_to_html '=head2 lalala'
180             <%= pod_to_html begin %>=head2 lalala<% end %>
181              
182             Render POD to HTML without preprocessing.
183              
184             =head1 METHODS
185              
186             L inherits all methods from
187             L and implements the following new ones.
188              
189             =head2 register
190              
191             my $route = $plugin->register(Mojolicious->new);
192             my $route = $plugin->register(Mojolicious->new, {name => 'foo'});
193              
194             Register renderer and helper in L application.
195              
196             =head1 SEE ALSO
197              
198             L, L, L.
199              
200             =cut