allow url prefix to be specified when rendering pod

metacpan · Jul 11, 2016 · b419e1e · b419e1e
1 parent a0af95f
commit b419e1e
Show file tree

Hide file tree

Showing 2 changed files with 4 additions and 1 deletion.
diff --git a/lib/MetaCPAN/Server/Controller/Pod.pm b/lib/MetaCPAN/Server/Controller/Pod.pm
@@ -14,6 +14,7 @@ sub find : 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};

diff --git a/lib/MetaCPAN/Server/View/Pod.pm b/lib/MetaCPAN/Server/View/Pod.pm
@@ -11,8 +11,9 @@ extends 'Catalyst::View';
 sub process {
     my ( $self, $c ) = @_;
 
-    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 );
@@ -23,6 +24,7 @@ sub process {
     $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 ) : () ),