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