From f2301244dc9a149bb58f901e62be86e5c31a5b12 Mon Sep 17 00:00:00 2001
From: Graham Knop <haarg@haarg.org>
Date: Wed, 2 Aug 2017 16:36:43 +0200
Subject: [PATCH] clean up redirects

---
 lib/MetaCPAN/Web/Controller/Module.pm  |  4 ++--
 lib/MetaCPAN/Web/Controller/Pod.pm     | 19 +++++++++++--------
 lib/MetaCPAN/Web/Controller/Release.pm |  7 +------
 lib/MetaCPAN/Web/Controller/Search.pm  |  6 +++---
 t/controller/pod.t                     |  7 +++++--
 t/controller/search.t                  | 14 +++++++++-----
 6 files changed, 31 insertions(+), 26 deletions(-)

diff --git a/lib/MetaCPAN/Web/Controller/Module.pm b/lib/MetaCPAN/Web/Controller/Module.pm
index 50778bd69e..e264292910 100644
--- a/lib/MetaCPAN/Web/Controller/Module.pm
+++ b/lib/MetaCPAN/Web/Controller/Module.pm
@@ -19,12 +19,12 @@ sub redirect_to_pod : Path : Args {
 
         # Force the author arg to uppercase to avoid another redirect.
         $c->res->redirect(
-            '/pod/release/' . join( q{/}, uc( shift @path ), @path ), 301 );
+            $c->uri_for( '/pod/release', uc( shift @path ), @path ), 301 );
     }
 
     # /module/Foo::Bar
     else {
-        $c->res->redirect( '/pod/' . join( q{/}, @path ), 301 );
+        $c->res->redirect( $c->uri_for( '/pod', @path ), 301 );
     }
 
     $c->detach();
diff --git a/lib/MetaCPAN/Web/Controller/Pod.pm b/lib/MetaCPAN/Web/Controller/Pod.pm
index 94755ac6b7..7dab01b20e 100644
--- a/lib/MetaCPAN/Web/Controller/Pod.pm
+++ b/lib/MetaCPAN/Web/Controller/Pod.pm
@@ -37,20 +37,23 @@ sub find : Path : Args(1) {
 
 # /pod/release/$AUTHOR/$release/@path
 sub release : Local : Args {
-    my ( $self, $c, @path ) = @_;
+    my ( $self, $c, $author, $release, @path ) = @_;
 
+    if ( !@path ) {
+        $c->detach('/not_found');
+    }
     $c->browser_max_age('1d');
 
     # force consistent casing in URLs
-    if ( @path > 2 && $path[0] ne uc( $path[0] ) ) {
+    if ( $author ne uc $author ) {
         $c->res->redirect(
-            '/pod/release/' . join( q{/}, uc( shift @path ), @path ), 301 );
+            $c->uri_for( $c->action, uc $author, $release, @path ), 301 );
         $c->detach();
     }
 
-    my $release_data = $c->model('ReleaseInfo')->get( @path[ 0, 1 ] )
-        ->else( sub { Future->done( {} ) } );
-    my $pod_file = $c->model('API::Module')->get(@path);
+    my $release_data
+        = $c->model('ReleaseInfo')->get( $author, $release )->else_done( {} );
+    my $pod_file = $c->model('API::Module')->get( $author, $release, @path );
     $c->stash(
         {
             pod_file => $pod_file->get,
@@ -59,7 +62,7 @@ sub release : Local : Args {
         }
     );
 
-    $c->forward( 'view', [@path] );
+    $c->forward( 'view', [ $author, $release, @path ] );
 }
 
 # /pod/distribution/$name/@path
@@ -96,7 +99,7 @@ sub view : Private {
     my $permalinks = $c->stash->{permalinks};
 
     if ( $data->{directory} ) {
-        $c->res->redirect( '/source/' . join( q{/}, @path ), 301 );
+        $c->res->redirect( $c->uri_for( '/source', @path ), 301 );
         $c->detach;
     }
 
diff --git a/lib/MetaCPAN/Web/Controller/Release.pm b/lib/MetaCPAN/Web/Controller/Release.pm
index 9f6449cb24..068104c67c 100644
--- a/lib/MetaCPAN/Web/Controller/Release.pm
+++ b/lib/MetaCPAN/Web/Controller/Release.pm
@@ -37,12 +37,7 @@ sub by_author_and_release : Chained('root') PathPart('') Args(2) {
     # force consistent casing in URLs
     if ( $author ne uc($author) ) {
         $c->res->redirect(
-            $c->uri_for_action(
-                $c->controller->action_for('by_author_and_release'),
-                [ uc($author), $release ]
-            ),
-            301
-        );
+            $c->uri_for_action( $c->action, uc($author), $release ), 301 );
         $c->detach();
     }
 
diff --git a/lib/MetaCPAN/Web/Controller/Search.pm b/lib/MetaCPAN/Web/Controller/Search.pm
index a69560f0f3..e322a9f4c0 100644
--- a/lib/MetaCPAN/Web/Controller/Search.pm
+++ b/lib/MetaCPAN/Web/Controller/Search.pm
@@ -47,7 +47,7 @@ sub index : Path : Args(0) {
         my $module = $model->first($query)->get;
         $module = $module->[0] if $module and is_arrayref($module);
         if ( $module && $module eq $query ) {
-            $c->res->redirect( '/pod/' . $module );
+            $c->res->redirect( $c->uri_for( '/pod', $module ) );
             $c->detach;
         }
         else {
@@ -55,11 +55,11 @@ sub index : Path : Args(0) {
             if (   $author->{total} == 1
                 && $query eq $author->{authors}->[0]->{pauseid} )
             {
-                $c->res->redirect( '/author/' . uc($query) );
+                $c->res->redirect( $c->uri_for( '/author', uc($query) ) );
                 $c->detach;
             }
             elsif ($module) {
-                $c->res->redirect("/pod/$module");
+                $c->res->redirect( $c->uri_for( '/pod', $module ) );
                 $c->detach;
             }
             else {
diff --git a/t/controller/pod.t b/t/controller/pod.t
index c8b49bab7d..84a1d0ad3b 100644
--- a/t/controller/pod.t
+++ b/t/controller/pod.t
@@ -23,6 +23,9 @@ test_psgi app, sub {
         'contains link to "this" version'
     );
 
+    # just in case, for comparisons
+    $this =~ s{^http://[^/]+}{};
+
     my $latest = $res->content;
     ok( $res = $cb->( GET $this ), "GET $this" );
     is(
@@ -45,8 +48,8 @@ test_psgi app, sub {
         =~ s{(/pod/release/)([^/]+)}{$1\L$2};    # lc author name
     ok( $res = $cb->( GET $lc_this ), "GET $lc_this" );
     is( $res->code, 301, '301 on lowercase author name' );
-    is( $res->headers->header('location'),
-        $this, 'redirect to uppercase author name' );
+    my $location = $res->headers->header('location') =~ s{^http://[^/]+}{}r;
+    is( $location, $this, 'redirect to uppercase author name' );
 };
 
 done_testing;
diff --git a/t/controller/search.t b/t/controller/search.t
index ccc198f994..23c4403539 100644
--- a/t/controller/search.t
+++ b/t/controller/search.t
@@ -62,23 +62,27 @@ test_psgi app, sub {
 
     ok( $res = $cb->( GET '/search?q=RJBS&lucky=1' ),
         'GET /search?q=&lucky=1' );
-    is( $res->headers->{location},
-        '/author/RJBS', 'get redirect to author page' );
+    is(
+        $res->headers->{location},
+        'http://localhost/author/RJBS',
+        'get redirect to author page'
+    );
 
     ok( $res = $cb->( GET '/search?q=JSON&lucky=1' ),
         'GET /search?q=&lucky=1' );
     is( $res->headers->{location},
-        '/pod/JSON', 'get redirect to pod page if module is found' );
+        'http://localhost/pod/JSON',
+        'get redirect to pod page if module is found' );
 
     ok( $res = $cb->( GET '/search?q=win32&lucky=1' ),
         'GET /search?q=&lucky=1' );
-    is( $res->headers->{location}, '/pod/Win32',
+    is( $res->headers->{location}, 'http://localhost/pod/Win32',
         'get redirect to pod page if module found and the query not upper case'
     );
 
     ok( $res = $cb->( GET '/search?q=WIN32&lucky=1' ),
         'GET /search?q=&lucky=1' );
-    is( $res->headers->{location}, '/author/WIN32',
+    is( $res->headers->{location}, 'http://localhost/author/WIN32',
         'get redirect to author page when author is found and search with upper case'
     );