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