Merge pull request #506 from metacpan/haarg/url-prefix-param

Add url_prefix option to pod endpoint
metacpan · Jul 12, 2016 · 3e4ce9b · 3e4ce9b
2 parents 4a338d5 + b419e1e
commit 3e4ce9b
Show file tree

Hide file tree

Showing 4 changed files with 69 additions and 67 deletions.
diff --git a/lib/MetaCPAN/Pod/Renderer.pm b/lib/MetaCPAN/Pod/Renderer.pm
@@ -17,6 +17,15 @@ has perldoc_url_prefix => (
     writer  => '_set_perldoc_url_prefix',
 );
 
+has nix_X_codes => ( is => 'ro' );
+
+has no_errata_section => (
+    is      => 'ro',
+    default => 1,
+);
+
+has link_mappings => ( is => 'ro' );
+
 sub markdown_renderer {
     my $self = shift;
     return Pod::Markdown->new(
@@ -41,8 +50,10 @@ sub html_renderer {
     $parser->html_footer('');
     $parser->html_header('');
     $parser->index(1);
-    $parser->no_errata_section(1);
+    $parser->no_errata_section( $self->no_errata_section );
     $parser->perldoc_url_prefix( $self->perldoc_url_prefix );
+    $parser->nix_X_codes( $self->nix_X_codes );
+    $parser->link_mappings( $self->link_mappings );
 
     return $parser;
 }

diff --git a/lib/MetaCPAN/Server/Controller/Pod.pm b/lib/MetaCPAN/Server/Controller/Pod.pm
@@ -11,6 +11,11 @@ with 'MetaCPAN::Server::Role::JSONP';
 
 sub find : Path('') {
     my ( $self, $c, $author, $release, @path ) = @_;
+    $c->stash->{link_mappings}
+        = $self->find_dist_links( $c, $author, $release,
+        !!$c->req->query_params->{permalinks} );
+    $c->stash->{url_prefix} = $c->req->query_params->{url_prefix};
+
     $c->forward( '/source/get', [ $author, $release, @path ] );
     my $path = $c->stash->{path};
     $c->detach( '/bad_request', ['Requested resource is a binary file'] )
@@ -28,4 +33,43 @@ sub get : Path('') : Args(1) {
     $c->forward( 'find', [ map { $module->$_ } qw(author release path) ] );
 }
 
+sub find_dist_links {
+    my ( $self, $c, $author, $release, $permalinks ) = @_;
+    my $module_query
+        = $c->model('CPAN::File')
+        ->documented_modules( { name => $release, author => $author } )
+        ->source( [qw(name module path documentation distribution)] );
+    my @modules = $module_query->all;
+
+    my $links = {};
+
+    for my $file (@modules) {
+        next
+            unless $file->has_documentation;
+        my $name = $file->documentation;
+        my ($module)
+            = grep { $_->name eq $name } @{ $file->module };
+        if ( $module && $module->authorized && $module->indexed ) {
+            if ($permalinks) {
+                $links->{$name} = join '/',
+                    'release', $author, $release, $file->path;
+            }
+            else {
+                $links->{$name} = $name;
+            }
+        }
+        next
+            if exists $links->{$name};
+        if ($permalinks) {
+            $links->{$name} = join '/',
+                'release', $author, $release, $file->path;
+        }
+        else {
+            $links->{$name} = join '/',
+                'distribution', $file->distribution, $file->path;
+        }
+    }
+    return $links;
+}
+
 1;
diff --git a/lib/MetaCPAN/Server/Controller/Source.pm b/lib/MetaCPAN/Server/Controller/Source.pm
@@ -32,10 +32,6 @@ sub get : Chained('index') : PathPart('') : Args {
         $c->res->body( $res->[2]->[0] );
     }
     else {
-        $c->stash->{link_mappings}
-            = $self->find_dist_links( $c, $author, $release,
-            !!$c->req->query_params->{permalinks} );
-
         $c->stash->{path} = $file;
 
         # Tell fastly to cache for a day (for st.aticpan.org,
@@ -52,45 +48,6 @@ sub get : Chained('index') : PathPart('') : Args {
     }
 }
 
-sub find_dist_links {
-    my ( $self, $c, $author, $release, $permalinks ) = @_;
-    my $module_query
-        = $c->model('CPAN::File')
-        ->documented_modules( { name => $release, author => $author } )
-        ->source( [qw(name module path documentation distribution)] );
-    my @modules = $module_query->all;
-
-    my $links = {};
-
-    for my $file (@modules) {
-        next
-            unless $file->has_documentation;
-        my $name = $file->documentation;
-        my ($module)
-            = grep { $_->name eq $name } @{ $file->module };
-        if ( $module && $module->authorized && $module->indexed ) {
-            if ($permalinks) {
-                $links->{$name} = join '/',
-                    'release', $author, $release, $file->path;
-            }
-            else {
-                $links->{$name} = $name;
-            }
-        }
-        next
-            if exists $links->{$name};
-        if ($permalinks) {
-            $links->{$name} = join '/',
-                'release', $author, $release, $file->path;
-        }
-        else {
-            $links->{$name} = join '/',
-                'distribution', $file->distribution, $file->path;
-        }
-    }
-    return $links;
-}
-
 sub module : Chained('index') : PathPart('') : Args(1) {
     my ( $self, $c, $module ) = @_;
     $module = $c->model('CPAN::File')->find($module)

diff --git a/lib/MetaCPAN/Server/View/Pod.pm b/lib/MetaCPAN/Server/View/Pod.pm
@@ -11,10 +11,9 @@ extends 'Catalyst::View';
 sub process {
     my ( $self, $c ) = @_;
 
-    my $renderer = MetaCPAN::Pod::Renderer->new;
-
-    my $content = $c->res->body || $c->stash->{source};
+    my $content       = $c->res->body || $c->stash->{source};
     my $link_mappings = $c->stash->{link_mappings};
+    my $url_prefix    = $c->stash->{url_prefix};
     $content = eval { join( q{}, $content->getlines ) };
 
     my ( $body, $content_type );
@@ -24,45 +23,36 @@ sub process {
     my $x_codes = $c->req->params->{x_codes};
     $x_codes = $c->config->{pod_html_x_codes} unless defined $x_codes;
 
+    my $renderer = $self->_factory(
+        ( $url_prefix ? ( perldoc_url_prefix => $url_prefix ) : () ),
+        no_errata_section => !$show_errors,
+        nix_X_codes       => !$x_codes,
+        ( $link_mappings ? ( link_mappings => $link_mappings ) : () ),
+    );
     if ( $accept eq 'text/plain' ) {
-        $body         = $self->_factory->to_text($content);
+        $body         = $renderer->to_text($content);
         $content_type = 'text/plain';
     }
     elsif ( $accept eq 'text/x-pod' ) {
-        $body         = $self->_factory->to_pod($content);
+        $body         = $renderer->to_pod($content);
         $content_type = 'text/plain';
     }
     elsif ( $accept eq 'text/x-markdown' ) {
-        $body         = $self->_factory->to_markdown($content);
+        $body         = $renderer->to_markdown($content);
         $content_type = 'text/plain';
     }
     else {
-        $body = $self->build_pod_html( $content, $show_errors, $x_codes,
-            $link_mappings );
+        $body         = $renderer->to_html($content);
         $content_type = 'text/html';
     }
 
     $c->res->content_type($content_type);
     $c->res->body($body);
 }
 
-sub build_pod_html {
-    my ( $self, $source, $show_errors, $x_codes, $link_mappings ) = @_;
-
-    my $renderer = $self->_factory->html_renderer;
-    $renderer->nix_X_codes( !$x_codes );
-    $renderer->no_errata_section( !$show_errors );
-    $renderer->link_mappings($link_mappings);
-
-    my $html = q{};
-    $renderer->output_string( \$html );
-    $renderer->parse_string_document($source);
-    return $html;
-}
-
 sub _factory {
     my $self = shift;
-    return MetaCPAN::Pod::Renderer->new;
+    return MetaCPAN::Pod::Renderer->new(@_);
 }
 
 1;