File Coverage

blib/lib/Mojolicious/Plugin/PODViewer.pm
Criterion Covered Total %
statement 99 99 100.0
branch 20 32 62.5
condition 9 19 47.3
subroutine 18 18 100.0
pod 1 1 100.0
total 147 169 86.9


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::PODViewer;
2             our $VERSION = '0.005';
3             # ABSTRACT: POD renderer plugin
4              
5             #pod =encoding utf8
6             #pod
7             #pod =head1 SYNOPSIS
8             #pod
9             #pod # Mojolicious (with documentation browser under "/perldoc")
10             #pod my $route = $app->plugin('PODViewer');
11             #pod my $route = $app->plugin(PODViewer => {name => 'foo'});
12             #pod my $route = $app->plugin(PODViewer => {preprocess => 'epl'});
13             #pod
14             #pod # Mojolicious::Lite (with documentation browser under "/perldoc")
15             #pod my $route = plugin 'PODViewer';
16             #pod my $route = plugin PODViewer => {name => 'foo'};
17             #pod my $route = plugin PODViewer => {preprocess => 'epl'};
18             #pod
19             #pod # Without documentation browser
20             #pod plugin PODViewer => {no_perldoc => 1};
21             #pod
22             #pod # foo.html.ep
23             #pod %= pod_to_html "=head1 TEST\n\nC<123>"
24             #pod
25             #pod # foo.html.pod
26             #pod =head1 <%= uc 'test' %>
27             #pod
28             #pod =head1 DESCRIPTION
29             #pod
30             #pod L is a renderer for Perl's POD (Plain
31             #pod Old Documentation) format. It includes a browser to browse the Perl
32             #pod module documentation as a website.
33             #pod
34             #pod This is a fork of the (deprecated) L.
35             #pod
36             #pod =head1 OPTIONS
37             #pod
38             #pod L supports the following options.
39             #pod
40             #pod =head2 name
41             #pod
42             #pod # Mojolicious::Lite
43             #pod plugin PODViewer => {name => 'foo'};
44             #pod
45             #pod Handler name, defaults to C.
46             #pod
47             #pod =head2 route
48             #pod
49             #pod The L to add documentation to. Defaults to
50             #pod C<< $app->routes->any('/perldoc') >>. The new route will have a name of
51             #pod C.
52             #pod
53             #pod =head2 default_module
54             #pod
55             #pod The default module to show. Defaults to C.
56             #pod
57             #pod =head2 allow_modules
58             #pod
59             #pod An arrayref of regular expressions that match modules to allow. At least
60             #pod one of the regular expressions must match. Disallowed modules will be
61             #pod redirected to the appropriate page on L.
62             #pod
63             #pod =head2 layout
64             #pod
65             #pod The layout to use. Defaults to C.
66             #pod
67             #pod =head2 no_perldoc
68             #pod
69             #pod # Mojolicious::Lite
70             #pod plugin PODViewer => {no_perldoc => 1};
71             #pod
72             #pod Disable L documentation browser that will otherwise be
73             #pod available under C.
74             #pod
75             #pod =head2 preprocess
76             #pod
77             #pod # Mojolicious::Lite
78             #pod plugin PODViewer => {preprocess => 'epl'};
79             #pod
80             #pod Name of handler used to preprocess POD, defaults to C.
81             #pod
82             #pod =head1 HELPERS
83             #pod
84             #pod L implements the following helpers.
85             #pod
86             #pod =head2 pod_to_html
87             #pod
88             #pod %= pod_to_html '=head2 lalala'
89             #pod <%= pod_to_html begin %>=head2 lalala<% end %>
90             #pod
91             #pod Render POD to HTML without preprocessing.
92             #pod
93             #pod =head1 TEMPLATES
94             #pod
95             #pod L bundles the following templates. To
96             #pod override this template with your own, create a template with the same name.
97             #pod
98             #pod =head2 podviewer/perldoc.html.ep
99             #pod
100             #pod This template displays the POD for a module. The HTML for the documentation
101             #pod is in the C content section (C<< <%= content 'perldoc' %> >>).
102             #pod The template has the following stash values:
103             #pod
104             #pod =over
105             #pod
106             #pod =item module
107             #pod
108             #pod The current module, with parts separated by C.
109             #pod
110             #pod =item cpan
111             #pod
112             #pod A link to L for the current module.
113             #pod
114             #pod =item topics
115             #pod
116             #pod An array of arrays of topics in the documentation. Each inner array is
117             #pod a set of pairs of C and C suitable to be passed
118             #pod directly to the C helper. New topics are started by a C<=head1>
119             #pod tag, and include all lower-level headings.
120             #pod
121             #pod =back
122             #pod
123             #pod =head2 layouts/podviewer.html.ep
124             #pod
125             #pod The layout for rendering POD pages. Use this to add stylesheets,
126             #pod JavaScript, and additional navigation. Set the C option to
127             #pod change this template.
128             #pod
129             #pod =head1 METHODS
130             #pod
131             #pod L inherits all methods from
132             #pod L and implements the following new ones.
133             #pod
134             #pod =head2 register
135             #pod
136             #pod my $route = $plugin->register(Mojolicious->new);
137             #pod my $route = $plugin->register(Mojolicious->new, {name => 'foo'});
138             #pod
139             #pod Register renderer and helper in L application.
140             #pod
141             #pod =head1 SEE ALSO
142             #pod
143             #pod L, L, L.
144             #pod
145             #pod =cut
146 1     1   1148 use Mojo::Base 'Mojolicious::Plugin';
  1         2  
  1         7  
147              
148 1     1   177 use Mojo::Asset::File;
  1         2  
  1         10  
149 1     1   24 use Mojo::ByteStream;
  1         2  
  1         30  
150 1     1   4 use Mojo::DOM;
  1         2  
  1         20  
151 1     1   4 use Mojo::File 'path';
  1         2  
  1         37  
152 1     1   5 use Mojo::URL;
  1         1  
  1         7  
153 1     1   482 use Pod::Simple::XHTML;
  1         9801  
  1         37  
154 1     1   548 use Pod::Simple::Search;
  1         5026  
  1         1237  
155              
156             sub register {
157 1     1 1 54 my ($self, $app, $conf) = @_;
158              
159 1   50     6 my $preprocess = $conf->{preprocess} || 'ep';
160             $app->renderer->add_handler(
161             $conf->{name} || 'pod' => sub {
162 3     3   25137 my ($renderer, $c, $output, $options) = @_;
163 3         10 $renderer->handlers->{$preprocess}($renderer, $c, $output, $options);
164 3 100       5884 $$output = _pod_to_html($$output) if defined $$output;
165             }
166 1   50     8 );
167              
168             $app->helper(
169 1     3   37 pod_to_html => sub { shift; Mojo::ByteStream->new(_pod_to_html(@_)) });
  3         34041  
  3         12  
170              
171             # Perldoc browser
172 1 50       125 return undef if $conf->{no_perldoc};
173              
174 1         2 push @{ $app->renderer->classes }, __PACKAGE__;
  1         3  
175 1   50     12 my $default_module = $conf->{default_module} // 'Mojolicious::Guides';
176 1         5 $default_module =~ s{::}{/}g;
177              
178             my $defaults = {
179             module => $default_module,
180             ( $conf->{layout} ? ( layout => $conf->{layout} ) : () ),
181 1 50 50     6 allow_modules => $conf->{allow_modules} // [ qr{} ],
182             };
183 1   33     4 my $route = $conf->{route} ||= $app->routes->any( '/perldoc' );
184 1         22 return $route->any( '/:module' =>
185             $defaults => [module => qr/[^.]+/] => \&_perldoc,
186             )->name('plugin.podviewer');
187             }
188              
189             sub _indentation {
190 5     5   7345 (sort map {/^(\s+)/} @{shift()})[0];
  14         52  
  5         15  
191             }
192              
193             sub _html {
194 4     4   14 my ($c, $src) = @_;
195              
196             # Rewrite links
197 4         15 my $dom = Mojo::DOM->new(_pod_to_html($src));
198 4         3411 my $base = 'https://metacpan.org/pod/';
199             $dom->find('a[href]')->map('attr')->each(sub {
200 3 50   3   1586 if ($_->{href} =~ m!^\Q$base\E([:\w]+)!) {
201 3         11 my $module = $1;
202             return undef
203 3 50       7 unless grep { $module =~ /$_/ } @{ $c->stash('allow_modules') || [] };
  3 50       54  
  3         13  
204 3         30 $_->{href} =~ s{^\Q$base$module\E}{$c->url_for(module => $module)}e;
  3         14  
205 3         1905 $_->{href} =~ s!::!/!gi
206             }
207 4         20 });
208              
209             # Rewrite code blocks for syntax highlighting and correct indentation
210 4         309 for my $e ($dom->find('pre > code')->each) {
211 3 50       1219 next if (my $str = $e->content) =~ /^\s*(?:\$|Usage:)\s+/m;
212 3 50       265 next unless $str =~ /[\$\@\%]\w|->\w|^use\s+\w/m;
213 3         11 my $attrs = $e->attr;
214 3         37 my $class = $attrs->{class};
215 3 50       16 $attrs->{class} = defined $class ? "$class prettyprint" : 'prettyprint';
216             }
217              
218             # Rewrite headers
219 4         183 my $toc = Mojo::URL->new->fragment('toc');
220 4         46 my @topics;
221 4         14 for my $e ($dom->find('h1, h2, h3, h4')->each) {
222              
223 13 100 66     8070 push @topics, [] if $e->tag eq 'h1' || !@topics;
224 13         210 my $link = Mojo::URL->new->fragment($e->{id});
225 13         298 push @{$topics[-1]}, my $text = $e->all_text, $link;
  13         35  
226 13         377 my $permalink = $c->link_to('#' => $link, class => 'permalink');
227 13         5186 $e->content($permalink . $c->link_to($text => $toc));
228             }
229              
230             # Try to find a title
231 4         2463 my $title = 'Perldoc';
232 4     3   15 $dom->find('h1 + p')->first(sub { $title = shift->all_text });
  3         2637  
233              
234             # Combine everything to a proper response
235 4         359 $c->content_for(perldoc => "$dom");
236 4         2195 $c->render('podviewer/perldoc', title => $title, topics => \@topics);
237             }
238              
239             sub _perldoc {
240 9     9   124188 my $c = shift;
241              
242             # Find module or redirect to CPAN
243 9         44 my $module = join '::', split('/', $c->param('module'));
244 9         331 $c->stash(cpan => "https://metacpan.org/pod/$module");
245              
246             return $c->redirect_to( $c->stash( 'cpan' ) )
247 9 50       164 unless grep { $module =~ /$_/ } @{ $c->stash( 'allow_modules' ) || [] };
  9 100       170  
  9         30  
248              
249             my $path
250 8         91 = Pod::Simple::Search->new->find($module, map { $_, "$_/pods" } @INC);
  80         502  
251 8 50 33     3615 return $c->redirect_to($c->stash('cpan')) unless $path && -r $path;
252              
253 8   50     43 $c->stash->{layout} //= 'podviewer';
254 8         97 my $src = path($path)->slurp;
255 8     4   861 $c->respond_to(txt => {data => $src}, html => sub { _html($c, $src) });
  4         2010  
256             }
257              
258             sub _pod_to_html {
259 9 100   9   45 return '' unless defined(my $pod = ref $_[0] eq 'CODE' ? shift->() : shift);
    50          
260              
261 9         105 my $parser = Pod::Simple::XHTML->new;
262 9         1007 $parser->perldoc_url_prefix('https://metacpan.org/pod/');
263 9         70 $parser->$_('') for qw(html_header html_footer);
264 9         122 $parser->strip_verbatim_indent(\&_indentation);
265 9         74 $parser->output_string(\(my $output));
266 9 50       1353 return $@ unless eval { $parser->parse_string_document("$pod"); 1 };
  9         43  
  9         7778  
267              
268 9         138 return $output;
269             }
270              
271             1;
272              
273             =pod
274              
275             =head1 NAME
276              
277             Mojolicious::Plugin::PODViewer - POD renderer plugin
278              
279             =head1 VERSION
280              
281             version 0.005
282              
283             =head1 SYNOPSIS
284              
285             # Mojolicious (with documentation browser under "/perldoc")
286             my $route = $app->plugin('PODViewer');
287             my $route = $app->plugin(PODViewer => {name => 'foo'});
288             my $route = $app->plugin(PODViewer => {preprocess => 'epl'});
289              
290             # Mojolicious::Lite (with documentation browser under "/perldoc")
291             my $route = plugin 'PODViewer';
292             my $route = plugin PODViewer => {name => 'foo'};
293             my $route = plugin PODViewer => {preprocess => 'epl'};
294              
295             # Without documentation browser
296             plugin PODViewer => {no_perldoc => 1};
297              
298             # foo.html.ep
299             %= pod_to_html "=head1 TEST\n\nC<123>"
300              
301             # foo.html.pod
302             =head1 <%= uc 'test' %>
303              
304             =head1 DESCRIPTION
305              
306             L is a renderer for Perl's POD (Plain
307             Old Documentation) format. It includes a browser to browse the Perl
308             module documentation as a website.
309              
310             This is a fork of the (deprecated) L.
311              
312             =encoding utf8
313              
314             =head1 OPTIONS
315              
316             L supports the following options.
317              
318             =head2 name
319              
320             # Mojolicious::Lite
321             plugin PODViewer => {name => 'foo'};
322              
323             Handler name, defaults to C.
324              
325             =head2 route
326              
327             The L to add documentation to. Defaults to
328             C<< $app->routes->any('/perldoc') >>. The new route will have a name of
329             C.
330              
331             =head2 default_module
332              
333             The default module to show. Defaults to C.
334              
335             =head2 allow_modules
336              
337             An arrayref of regular expressions that match modules to allow. At least
338             one of the regular expressions must match. Disallowed modules will be
339             redirected to the appropriate page on L.
340              
341             =head2 layout
342              
343             The layout to use. Defaults to C.
344              
345             =head2 no_perldoc
346              
347             # Mojolicious::Lite
348             plugin PODViewer => {no_perldoc => 1};
349              
350             Disable L documentation browser that will otherwise be
351             available under C.
352              
353             =head2 preprocess
354              
355             # Mojolicious::Lite
356             plugin PODViewer => {preprocess => 'epl'};
357              
358             Name of handler used to preprocess POD, defaults to C.
359              
360             =head1 HELPERS
361              
362             L implements the following helpers.
363              
364             =head2 pod_to_html
365              
366             %= pod_to_html '=head2 lalala'
367             <%= pod_to_html begin %>=head2 lalala<% end %>
368              
369             Render POD to HTML without preprocessing.
370              
371             =head1 TEMPLATES
372              
373             L bundles the following templates. To
374             override this template with your own, create a template with the same name.
375              
376             =head2 podviewer/perldoc.html.ep
377              
378             This template displays the POD for a module. The HTML for the documentation
379             is in the C content section (C<< <%= content 'perldoc' %> >>).
380             The template has the following stash values:
381              
382             =over
383              
384             =item module
385              
386             The current module, with parts separated by C.
387              
388             =item cpan
389              
390             A link to L for the current module.
391              
392             =item topics
393              
394             An array of arrays of topics in the documentation. Each inner array is
395             a set of pairs of C and C suitable to be passed
396             directly to the C helper. New topics are started by a C<=head1>
397             tag, and include all lower-level headings.
398              
399             =back
400              
401             =head2 layouts/podviewer.html.ep
402              
403             The layout for rendering POD pages. Use this to add stylesheets,
404             JavaScript, and additional navigation. Set the C option to
405             change this template.
406              
407             =head1 METHODS
408              
409             L inherits all methods from
410             L and implements the following new ones.
411              
412             =head2 register
413              
414             my $route = $plugin->register(Mojolicious->new);
415             my $route = $plugin->register(Mojolicious->new, {name => 'foo'});
416              
417             Register renderer and helper in L application.
418              
419             =head1 SEE ALSO
420              
421             L, L, L.
422              
423             =head1 AUTHORS
424              
425             =over 4
426              
427             =item *
428              
429             Sebastian Riedel
430              
431             =item *
432              
433             Doug Bell
434              
435             =back
436              
437             =head1 CONTRIBUTORS
438              
439             =for stopwords brad CandyAngel Oleg Tekki Zoffix Znet
440              
441             =over 4
442              
443             =item *
444              
445             brad
446              
447             =item *
448              
449             CandyAngel
450              
451             =item *
452              
453             Oleg
454              
455             =item *
456              
457             Tekki
458              
459             =item *
460              
461             Zoffix Znet
462              
463             =back
464              
465             =head1 COPYRIGHT AND LICENSE
466              
467             This software is copyright (c) 2018 by Sebastian Riedel, Doug Bell.
468              
469             This is free software; you can redistribute it and/or modify it under
470             the same terms as the Perl 5 programming language system itself.
471              
472             =cut
473              
474             __DATA__