Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
added POD browser to Mojolicious::Plugin::PodRenderer
  • Loading branch information
kraih committed Dec 16, 2010
1 parent 8db0409 commit 5f2f0ae
Show file tree
Hide file tree
Showing 8 changed files with 183 additions and 28 deletions.
2 changes: 2 additions & 0 deletions Changes
Expand Up @@ -4,6 +4,8 @@ This file documents the revision history for Perl extension Mojolicious.
- Code name "Snowflake", this is a major release.
- Deprecated handler and helper attributes in Mojolicious::Renderer.
- Added new exception and not_found templates.
- Added POD browser to Mojolicious::Plugin::PodRenderer.
- Disabled debug log messages for static files.
- Improved Hypnotoad web server to restart workers regularly.
- Improved documentation.
- Improved query manipulation in Mojo::URL. (yko)
Expand Down
7 changes: 0 additions & 7 deletions lib/Mojolicious.pm
Expand Up @@ -177,13 +177,6 @@ sub dispatch {
# Hook
$self->plugins->run_hook(before_dispatch => $c);

# New request
my $req = $c->req;
my $method = $req->method;
my $path = $req->url->path || '/';
my $ua = $req->headers->user_agent || 'Anonymojo';
$self->log->debug(qq/$method $path ($ua)./);

# Try to find a static file
$self->static->dispatch($c);

Expand Down
3 changes: 3 additions & 0 deletions lib/Mojolicious/Command/Generate/App.pm
Expand Up @@ -92,6 +92,9 @@ use base 'Mojolicious';
sub startup {
my $self = shift;
# Perldoc browser under "/perldoc" (this plugin requires Perl 5.10)
$self->plugin('pod_renderer');
# Routes
my $r = $self->routes;
Expand Down
3 changes: 3 additions & 0 deletions lib/Mojolicious/Command/Generate/LiteApp.pm
Expand Up @@ -33,6 +33,9 @@ __DATA__
use Mojolicious::Lite;
# Perldoc browser under "/perldoc" (this plugin requires Perl 5.10)
plugin 'pod_renderer';
get '/welcome' => sub {
my $self = shift;
$self->render('index');
Expand Down
23 changes: 16 additions & 7 deletions lib/Mojolicious/Controller.pm
Expand Up @@ -464,13 +464,21 @@ sub render_not_found {
# Recursion
return if $stash->{'mojo.not_found'};

# Check for POD plugin
my $guide =
$self->app->renderer->helpers->{pod_to_html}
? $self->url_for('/perldoc?Mojolicious::Guides')
: 'http://search.cpan.org/dist/Mojolicious/lib/Mojolicious/Guides.pod';


# Render not found template
my $options = {
template => 'not_found',
format => 'html',
status => 404,
layout => undef,
extends => undef,
guide => $guide,
'mojo.not_found' => 1
};

Expand All @@ -483,6 +491,7 @@ sub render_not_found {
status => 404,
layout => undef,
extends => undef,
guide => $guide,
'mojo.not_found' => 1
);
}
Expand Down Expand Up @@ -786,15 +795,14 @@ __DATA__
<meta http-equiv="Expires" content="-1">
%= base_tag
%= javascript 'js/jquery.js'
%= stylesheet 'css/prettify.css'
%= stylesheet 'css/prettify-mojo.css'
%= javascript 'js/prettify.js'
<style type="text/css">
body {
background-color: #f5f6f8;
color: #333;
font: 0.9em Verdana, sans-serif;
margin-top: 0em;
margin-top: 0;
margin-left: 3em;
margin-right: 3em;
text-shadow: #ddd 0 1px 0;
Expand Down Expand Up @@ -831,6 +839,7 @@ __DATA__
.code {
background-color: #1a1a1a;
color: #eee;
font-family: 'Menlo', 'Monaco', Courier, monospace !important;
text-shadow: #333 0 1px 0;
}
.file {
Expand All @@ -845,7 +854,9 @@ __DATA__
text-weight: bold;
}
.preview {
background-color: #2f3032;
-moz-border-radius: 5px;
border-radius: 5px;
background-color: #1a1a1a;
padding: 0.5em;
margin-bottom: 1em;
}
Expand Down Expand Up @@ -1010,7 +1021,6 @@ __DATA__
<!doctype html><html>
<head>
<title>Not Found</title>
%= stylesheet 'css/prettify.css'
%= stylesheet 'css/prettify-mojo.css'
%= javascript 'js/prettify.js'
<style type="text/css">
Expand Down Expand Up @@ -1056,6 +1066,7 @@ __DATA__
-moz-border-radius: 5px;
border-radius: 5px;
background-color: #1a1a1a;
font-family: 'Menlo', 'Monaco', Courier, monospace !important;
font-size: 1.5em;
margin: 0;
text-align: left;
Expand Down Expand Up @@ -1096,9 +1107,7 @@ get '<%= $self->req->url->path %>' => sub {
<section id="documentation">
<h1>
You might also enjoy our excellent documentation in
<%= link_to 'perldoc Mojolicious::Guides',
'http://search.cpan.org' .
'/dist/Mojolicious/lib/Mojolicious/Guides.pod' %>
<%= link_to 'perldoc Mojolicious::Guides', $guide %>
</h1>
<img src="amelia.png" alt="Amelia">
</section>
Expand Down
130 changes: 128 additions & 2 deletions lib/Mojolicious/Plugin/PodRenderer.pm
Expand Up @@ -5,15 +5,23 @@ use warnings;

use base 'Mojolicious::Plugin';

use IO::File;
use Mojo::ByteStream 'b';
use Mojo::Command;
use Mojo::DOM;

# Core module since Perl 5.9.3, so it might not always be present
BEGIN {
die <<'EOF' unless eval { require Pod::Simple::HTML; 1 } }
Module "Pod::Simple::HTML" not present in this version of Perl.
Module "Pod::Simple" not present in this version of Perl.
Please install it manually or upgrade Perl to at least version 5.10.
EOF

use Pod::Simple::Search;

# Perldoc template
our $PERLDOC = Mojo::Command->new->get_data('perldoc.html.ep', __PACKAGE__);

# This is my first visit to the Galaxy of Terror and I'd like it to be a
# pleasant one.
sub register {
Expand All @@ -23,6 +31,7 @@ sub register {
$conf ||= {};
my $name = $conf->{name} || 'pod';
my $preprocess = $conf->{preprocess} || 'ep';
my $prefix = $conf->{prefix} || 'perldoc';

# Add "pod" handler
$app->renderer->add_handler(
Expand All @@ -37,6 +46,60 @@ sub register {

# Add "pod_to_html" helper
$app->helper(pod_to_html => sub { shift; b($self->_pod_to_html(@_)) });

# Perldoc
$app->routes->any(
$prefix => sub {
my $self = shift;

# Module
my $module = $self->req->url->query->params->[0]
|| 'Mojolicious::Lite';

# Path
my $path = Pod::Simple::Search->new->find($module);

# Redirect to CPAN
my $cpan = 'http://search.cpan.org/perldoc';
return $self->redirect_to(
"$cpan?" . $self->req->url->query->to_string)
unless $path && -r $path;

# POD
my $file = IO::File->new;
$file->open("< $path");
my $dom =
Mojo::DOM->new->parse($self->pod_to_html(join '', <$file>));
$dom->find('a[href]')->each(
sub {
my $attrs = shift->attrs;
if ($attrs->{href} =~ /^$cpan/) {
my $url = $self->url_for("/$prefix");
$attrs->{href} =~ s/^$cpan/$url/;
}
}
);
$dom->find('pre')->each(
sub {
my $attrs = shift->attrs;
my $class = $attrs->{class};
$attrs->{class} =
defined $class ? "$class prettyprint" : 'prettyprint';
}
);

# Title
my $title = 'Perldoc';
$dom->find('h1 + p')->until(sub { $title = shift->text });

# Render
$self->render(
inline => $PERLDOC,
perldoc => "$dom",
title => $title
);
}
) if $prefix;
}

sub _pod_to_html {
Expand All @@ -58,7 +121,7 @@ sub _pod_to_html {
# Parse
my $output;
$parser->output_string(\$output);
eval { $parser->parse_string_document("=pod\n\n$pod") };
eval { $parser->parse_string_document($pod) };
return $@ if $@;

# Filter
Expand All @@ -69,6 +132,69 @@ sub _pod_to_html {
}

1;
__DATA__
@@ perldoc.html.ep
<!doctype html><html>
<head>
<title><%= $title %></title>
%= stylesheet 'css/prettify-mojo.css'
%= javascript 'js/prettify.js'
<style type="text/css">
a { color: inherit; }
body {
background-color: #f5f6f8;
color: #333;
font: 0.9em Verdana, sans-serif;
margin-top: 0;
margin-left: 5em;
margin-right: 5em;
text-shadow: #ddd 0 1px 0;
}
footer {
text-align: center;
padding-top: 1em;
}
h1, h2, h3 {
font: 1.5em Georgia, Times, serif;
margin: 0;
}
pre {
-moz-border-radius: 5px;
border-radius: 5px;
background-color: #1a1a1a;
color: #eee;
font-family: 'Menlo', 'Monaco', Courier, monospace !important;
text-shadow: #333 0 1px 0;
text-align: left;
padding-bottom: 1.5em;
padding-top: 1.5em;
}
#perldoc {
-moz-border-radius-bottomleft: 5px;
border-bottom-left-radius: 5px;
-moz-border-radius-bottomright: 5px;
border-bottom-right-radius: 5px;
-moz-box-shadow: 0px 0px 2px #ccc;
-webkit-box-shadow: 0px 0px 2px #ccc;
box-shadow: 0px 0px 2px #ccc;
background-color: #fff;
padding: 3em;
}
</style>
</head>
<body onload="prettyPrint()">
<section id="perldoc">
%== $perldoc
</section>
<footer>
%= link_to 'http://mojolicio.us' => begin
<img src="mojolicious-black.png" alt="Mojolicious logo">
% end
</footer>
</body>
</html>
__END__
=head1 NAME
Expand Down
32 changes: 28 additions & 4 deletions lib/Mojolicious/Plugin/RequestTimer.pm
Expand Up @@ -14,24 +14,48 @@ sub register {

# Start timer
$app->hook(
before_dispatch => sub {
shift->stash('mojo.started' => [Time::HiRes::gettimeofday()]);
after_static_dispatch => sub {
my $self = shift;

# Stash
my $stash = $self->stash;

# Static file
$stash->{'mojo.static'} = 1 if $self->res->code;


# New request
my $req = $self->req;
my $method = $req->method;
my $path = $req->url->path || '/';
my $ua = $req->headers->user_agent || 'Anonymojo';
$self->app->log->debug(qq/$method $path ($ua)./)
unless $stash->{'mojo.static'};

# Start
$self->stash('mojo.started' => [Time::HiRes::gettimeofday()]);
}
);

# End timer
$app->hook(
after_dispatch => sub {
my $self = shift;
return unless my $started = $self->stash('mojo.started');

# Stash
my $stash = $self->stash;

# Time
return unless my $started = $stash->{'mojo.started'};
my $elapsed = sprintf '%f',
Time::HiRes::tv_interval($started,
[Time::HiRes::gettimeofday()]);
my $rps = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
my $res = $self->res;
my $code = $res->code || 200;
my $message = $res->message || $res->default_message($code);
$self->app->log->debug("$code $message (${elapsed}s, $rps/s).");
$self->app->log->debug("$code $message (${elapsed}s, $rps/s).")
unless $stash->{'mojo.static'};
}
);
}
Expand Down

0 comments on commit 5f2f0ae

Please sign in to comment.