improved documentation browser with source links

mojolicious · Sep 20, 2013 · 1b080a1 · 1b080a1
1 parent 3609300
commit 1b080a1
Show file tree

Hide file tree

Showing 10 changed files with 62 additions and 50 deletions.
diff --git a/Changes b/Changes
@@ -2,8 +2,11 @@
 4.40  2013-09-20
   - Added siblings method to Mojo::DOM.
   - Added flatten method to Mojo::Collection.
+  - Improved documentation browser with source links.
   - Fixed smart whitespace trimming bug in Mojo::DOM.
   - Fixed table parsing bug in Mojo::DOM::HTML.
+  - Fixed bug in Mojolicious::Types where txt MIME type did not specify a
+    charset.
 
 4.39  2013-09-17
   - Improved HTML5.1 compliance of Mojo::DOM::HTML.

diff --git a/lib/Mojolicious/Plugin/PODRenderer.pm b/lib/Mojolicious/Plugin/PODRenderer.pm
@@ -45,55 +45,48 @@ sub _perldoc {
   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');
+
   # Rewrite links
-  my $dom     = Mojo::DOM->new(_pod_to_html(slurp $path));
+  my $dom     = Mojo::DOM->new(_pod_to_html($source));
   my $perldoc = $self->url_for('/perldoc/');
-  $dom->find('a[href]')->each(
-    sub {
-      my $attrs = shift->attr;
-      $attrs->{href} =~ s!%3A%3A!/!gi
-        if $attrs->{href} =~ s!^http://search\.cpan\.org/perldoc\?!$perldoc!;
-    }
-  );
+  for my $e ($dom->find('a[href]')->each) {
+    my $attrs = $e->attr;
+    $attrs->{href} =~ s!%3A%3A!/!gi
+      if $attrs->{href} =~ s!^http://search\.cpan\.org/perldoc\?!$perldoc!;
+  }
 
   # Rewrite code blocks for syntax highlighting
-  $dom->find('pre')->each(
-    sub {
-      my $e = shift;
-      return if $e->all_text =~ /^\s*\$\s+/m;
-      my $attrs = $e->attr;
-      my $class = $attrs->{class};
-      $attrs->{class} = defined $class ? "$class prettyprint" : 'prettyprint';
-    }
-  );
+  for my $e ($dom->find('pre')->each) {
+    next if $e->all_text =~ /^\s*\$\s+/m;
+    my $attrs = $e->attr;
+    my $class = $attrs->{class};
+    $attrs->{class} = defined $class ? "$class prettyprint" : 'prettyprint';
+  }
 
   # Rewrite headers
   my $url = $self->req->url->clone;
   my (%anchors, @parts);
-  $dom->find('h1, h2, h3')->each(
-    sub {
-      my $e = shift;
-
-      # Anchor and text
-      my $name = my $text = $e->all_text;
-      $name =~ s/\s+/_/g;
-      $name =~ s/[^\w\-]//g;
-      my $anchor = $name;
-      my $i      = 1;
-      $anchor = $name . $i++ while $anchors{$anchor}++;
-
-      # Rewrite
-      push @parts, [] if $e->type eq 'h1' || !@parts;
-      push @{$parts[-1]}, $text, $url->fragment($anchor)->to_abs;
-      $e->replace_content(
-        $self->link_to(
-          $text => $url->fragment('toc')->to_abs,
-          class => 'mojoscroll',
-          id    => $anchor
-        )
-      );
-    }
-  );
+  for my $e ($dom->find('h1, h2, h3')->each) {
+
+    # Anchor and text
+    my $name = my $text = $e->all_text;
+    $name =~ s/\s+/_/g;
+    $name =~ s/[^\w\-]//g;
+    my $anchor = $name;
+    my $i      = 1;
+    $anchor = $name . $i++ while $anchors{$anchor}++;
+
+    # Rewrite
+    push @parts, [] if $e->type eq 'h1' || !@parts;
+    push @{$parts[-1]}, $text, $url->to_abs->fragment($anchor);
+    my $toc = $url->to_abs->fragment('toc');
+    $e->replace_content(
+      $self->link_to($text => $toc, class => 'mojoscroll', id => $anchor));
+  }
 
   # Try to find a title
   my $title = 'Perldoc';

diff --git a/lib/Mojolicious/Types.pm b/lib/Mojolicious/Types.pm
@@ -24,7 +24,7 @@ has types => sub {
     png      => ['image/png'],
     rss      => ['application/rss+xml'],
     svg      => ['image/svg+xml'],
-    txt      => ['text/plain'],
+    txt      => ['text/plain;charset=UTF-8'],
     webm     => ['video/webm'],
     woff     => ['application/font-woff'],
     xml      => ['application/xml', 'text/xml'],
@@ -101,7 +101,7 @@ L<Mojolicious::Types> manages MIME types for L<Mojolicious>.
   png      -> image/png
   rss      -> application/rss+xml
   svg      -> image/svg+xml
-  txt      -> text/plain
+  txt      -> text/plain;charset=UTF-8
   webm     -> video/webm
   woff     -> application/font-woff
   xml      -> application/xml,text/xml

diff --git a/lib/Mojolicious/templates/perldoc.html.ep b/lib/Mojolicious/templates/perldoc.html.ep
@@ -50,6 +50,7 @@
         padding-top: 70px;
       }
       #perldoc > ul:first-of-type a { text-decoration: none }
+      #source { padding-bottom: 1em }
       #wrapperlicious {
         max-width: 1000px;
         margin: 0 auto;
@@ -63,6 +64,15 @@
     % end
     <div id="wrapperlicious">
       <div id="perldoc">
+        <div id="source">
+          % my $path;
+          % for my $part (split '/', $module) {
+            /
+            % $path .= "/$part";
+            %= link_to $part => url_for("/perldoc$path")
+          % }
+          (<%= link_to 'source' => url_for->query({source => 1}) %>)
+        </div>
         <h1><a id="toc">TABLE OF CONTENTS</a></h1>
         <ul>
           % for my $part (@$parts) {

diff --git a/t/mojolicious/app.t b/t/mojolicious/app.t
@@ -302,7 +302,7 @@ $t->get_ok('/foo/withlayout' => {'X-Test' => 'Hi there!'})->status_is(200)
 # Foo::withBlock
 $t->get_ok('/withblock.txt' => {'X-Test' => 'Hi there!'})->status_is(200)
   ->header_is(Server => 'Mojolicious (Perl)')->content_type_isnt('text/html')
-  ->content_type_is('text/plain')
+  ->content_type_is('text/plain;charset=UTF-8')
   ->content_like(qr/Hello Baerbel\.\s+Hello Wolfgang\./);
 
 # MojoliciousTest2::Foo::test
@@ -372,7 +372,7 @@ my $mtime = Mojo::Date->new((stat $path)[9])->to_string;
 $t->get_ok('/hello.txt')->status_is(200)
   ->header_is(Server => 'Mojolicious (Perl)')
   ->header_is('Last-Modified' => $mtime)->header_is('Content-Length' => $size)
-  ->content_type_is('text/plain')
+  ->content_type_is('text/plain;charset=UTF-8')
   ->content_like(qr/Hello Mojo from a development static file!/);
 
 # Try to access a file which is not under the web root via path

diff --git a/t/mojolicious/charset_lite_app.t b/t/mojolicious/charset_lite_app.t
@@ -82,8 +82,8 @@ $t->post_ok('/' => {'Content-Type' => 'multipart/form-data'} => form =>
   ->content_type_like(qr/Shift_JIS/)->content_like(qr/$yatta/);
 
 # Unicode renderer
-$t->get_ok('/unicode')->status_is(200)->content_type_is('text/plain')
-  ->content_is(b($yatta)->encode('UTF-8')->to_string);
+$t->get_ok('/unicode')->status_is(200)
+  ->content_type_is('text/plain;charset=UTF-8')->content_is($yatta);
 
 # Templates in the DATA section should be written in UTF-8,
 # and those in separate files in Shift_JIS (Mojo will do the decoding)

diff --git a/t/mojolicious/group_lite_app.t b/t/mojolicious/group_lite_app.t
@@ -394,7 +394,8 @@ $t->get_ok('/some_formats')->status_is(404)
   ->content_type_is('text/html;charset=UTF-8')->content_is("Oops!\n");
 
 # Format "txt" has been detected
-$t->get_ok('/some_formats.txt')->status_is(200)->content_type_is('text/plain')
+$t->get_ok('/some_formats.txt')->status_is(200)
+  ->content_type_is('text/plain;charset=UTF-8')
   ->content_is('Some format detection.');
 
 # Format "json" has been detected

diff --git a/t/mojolicious/layouted_lite_app.t b/t/mojolicious/layouted_lite_app.t
@@ -123,7 +123,8 @@ $t->get_ok('/works?blue=1')->status_is(200)
   ->content_is("BlueJust worksThis <template> just works!\n\n");
 
 # Mixed formats
-$t->get_ok('/mixed')->status_is(200)->content_type_is('text/plain')
+$t->get_ok('/mixed')->status_is(200)
+  ->content_type_is('text/plain;charset=UTF-8')
   ->content_is("Mixed formats\n\n");
 
 # Missing template

diff --git a/t/mojolicious/longpolling_lite_app.t b/t/mojolicious/longpolling_lite_app.t
@@ -377,7 +377,7 @@ $t->get_ok('/longpoll/static/delayed')->status_is(200)
   ->header_is(Server => 'Mojolicious (Perl)')
   ->header_like('Set-Cookie' => qr/bar=baz/)
   ->header_like('Set-Cookie' => qr/mojolicious=/)
-  ->content_type_is('text/plain')
+  ->content_type_is('text/plain;charset=UTF-8')
   ->content_is("Hello Mojo from a static file!\n");
 is $stash->{finished}, 1, 'finish event has been emitted once';
 ok $stash->{destroyed}, 'controller has been destroyed';

diff --git a/t/mojolicious/pod_renderer_lite_app.t b/t/mojolicious/pod_renderer_lite_app.t
@@ -62,6 +62,10 @@ $t->get_ok('/perldoc/Mojolicious')->status_is(200)
   ->text_is('h1 a[id="NAME"]', 'NAME')->text_is('a[id="handler"]', 'handler')
   ->text_like('p', qr/Mojolicious/)->content_like(qr/Sebastian Riedel/);
 
+# Perldoc browser (Mojolicious source)
+$t->get_ok('/perldoc/Mojolicious?source=1')->status_is(200)
+  ->content_type_is('text/plain;charset=UTF-8')->content_like(qr/\$VERSION/);
+
 done_testing();
 
 __DATA__