improved documentation browser to be a little more RESTful

mojolicious · Sep 21, 2013 · 34b6434 · 34b6434
1 parent 3aa9dc5
commit 34b6434
Show file tree

Hide file tree

Showing 5 changed files with 30 additions and 19 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,6 @@
 
 4.41  2013-09-22
+  - Improved documentation browser to be a little more RESTful.
   - Fixed flatten to work with older versions of Perl. (jamadam)
 
 4.40  2013-09-21

diff --git a/lib/Mojolicious/Controller.pm b/lib/Mojolicious/Controller.pm
@@ -880,6 +880,9 @@ that all stash values with a C<mojo.*> prefix are reserved for internal use.
 
 Generate a portable L<Mojo::URL> object with base for a route, path or URL.
 
+  # "http://127.0.0.1:3000/perldoc" if application has been started with Morbo
+  $c->url_for('/perldoc')->to_abs;
+
   # "/perldoc?foo=bar" if application is deployed under "/"
   $c->url_for('/perldoc')->query(foo => 'bar');
 

diff --git a/lib/Mojolicious/Plugin/PODRenderer.pm b/lib/Mojolicious/Plugin/PODRenderer.pm
@@ -31,27 +31,17 @@ sub register {
 
   # Perldoc browser
   return if $conf->{no_perldoc};
+  my $defaults    = {module => 'Mojolicious/Guides', format => 'html'};
+  my $constraints = [module => qr/[^.]+/,            format => [qw(html txt)]];
   return $app->routes->any(
-    '/perldoc/*module' => {module => 'Mojolicious/Guides'} => \&_perldoc);
+    '/perldoc/:module' => $defaults => $constraints => \&_perldoc);
 }
 
-sub _perldoc {
-  my $self = shift;
-
-  # Find module or redirect to CPAN
-  my $module = $self->param('module');
-  $module =~ s!/!::!g;
-  my $path = Pod::Simple::Search->new->find($module, @PATHS);
-  return $self->redirect_to("http://metacpan.org/module/$module")
-    unless $path && -r $path;
-
-  # Source
-  my $source = slurp $path;
-  return $self->render(data => $source, format => 'txt')
-    if $self->param('source');
+sub _html {
+  my ($self, $src) = @_;
 
   # Rewrite links
-  my $dom     = Mojo::DOM->new(_pod_to_html($source));
+  my $dom     = Mojo::DOM->new(_pod_to_html($src));
   my $perldoc = $self->url_for('/perldoc/');
   for my $e ($dom->find('a[href]')->each) {
     my $attrs = $e->attr;
@@ -96,7 +86,20 @@ sub _perldoc {
   $self->content_for(perldoc => "$dom");
   my $template = $self->app->renderer->_bundled('perldoc');
   $self->render(inline => $template, title => $title, parts => \@parts);
-  $self->res->headers->content_type('text/html;charset="UTF-8"');
+}
+
+sub _perldoc {
+  my $self = shift;
+
+  # Find module or redirect to CPAN
+  my $module = $self->param('module');
+  $module =~ s!/!::!g;
+  my $path = Pod::Simple::Search->new->find($module, @PATHS);
+  return $self->redirect_to("http://metacpan.org/module/$module")
+    unless $path && -r $path;
+
+  my $src = slurp $path;
+  $self->respond_to(txt => {data => $src}, any => sub { _html($self, $src) });
 }
 
 sub _pod_to_html {

diff --git a/lib/Mojolicious/templates/perldoc.html.ep b/lib/Mojolicious/templates/perldoc.html.ep
@@ -71,7 +71,7 @@
             % $path .= "/$part";
             %= link_to $part => url_for("/perldoc$path")
           % }
-          (<%= link_to 'source' => url_for->query({source => 1}) %>)
+          (<%= link_to 'source' => url_for("/perldoc$path.txt") %>)
         </div>
         <h1><a id="toc">TABLE OF CONTENTS</a></h1>
         <ul>

diff --git a/t/mojolicious/pod_renderer_lite_app.t b/t/mojolicious/pod_renderer_lite_app.t
@@ -63,7 +63,11 @@ $t->get_ok('/perldoc/Mojolicious')->status_is(200)
   ->text_like('p', qr/Mojolicious/)->content_like(qr/Sebastian Riedel/);
 
 # Perldoc browser (Mojolicious source)
-$t->get_ok('/perldoc/Mojolicious?source=1')->status_is(200)
+$t->get_ok('/perldoc/Mojolicious.txt')->status_is(200)
+  ->content_type_is('text/plain;charset=UTF-8')->content_like(qr/\$VERSION/);
+
+# Perldoc browser (negotiated Mojolicious source)
+$t->get_ok('/perldoc/Mojolicious' => {Accept => 'text/plain'})->status_is(200)
   ->content_type_is('text/plain;charset=UTF-8')->content_like(qr/\$VERSION/);
 
 done_testing();