avoid overwriting Location in fabricated PSGI responses

Changes

@@ -1,5 +1,8 @@
 Revision history for Plack-Middleware-Rewrite
 
+1.005 Thu 07 Jun 2012
+	- Preserve pre-existing Location header in fabricated responses
+
 1.004 Thu 29 Mar 2012
 	- Preserve query params in external redirects by dropping unnecessary use of URI
 	  (with thanks to Wallace Reis)

dist.ini

@@ -1,5 +1,5 @@
 name    = Plack-Middleware-Rewrite
-version = 1.004
+version = 1.005
 author  = Aristotle Pagaltzis <pagaltzis@gmx.de>
 license = Perl_5
 copyright_holder = Aristotle Pagaltzis

lib/Plack/Middleware/Rewrite.pm

@@ -40,8 +40,10 @@ sub call {
 		$res = $self->app->( $env );
 	}
 	elsif ( $res->[0] =~ /\A3[0-9][0-9]\z/ ) {
-		my $dest = Plack::Request->new( $env )->uri;
-		Plack::Util::header_set( $res->[1], Location => $dest );
+		if ( not Plack::Util::header_exists( $res->[1], 'Location' ) ) {
+			my $dest = Plack::Request->new( $env )->uri;
+			Plack::Util::header_set( $res->[1], Location => $dest );
+		}
 	}
 
 	return $res if not $modify_cb;

t/rewrite.t

@@ -23,6 +23,9 @@ $app = builder {
 		return sub { $_->set( 'Content-Type', $xhtml ) }
 			if $_[0]{'HTTP_ACCEPT'} =~ m{application/xhtml\+xml(?!\s*;\s*q=0)};
 
+		return [ 302, [ Location => 'http://localhost/correct' ], [] ]
+			if m{^/psgi-redirect};
+
 		s{^/baz$}{/quux};
 	};
 	$app;
@@ -68,6 +71,11 @@ test_psgi app => $app, client => sub {
 	is $res->header( 'Content-Type' ), 'text/plain', '... with headers';
 	is $res->content, 'Goodbye Web', '... body, and all.';
 
+	$req = GET 'http://localhost/psgi-redirect';
+	$res = $cb->( $req );
+	is $res->code, 302, 'Fabricated responses can be redirects';
+	is $res->header( 'Location' ), 'http://localhost/correct', '... with proper destination';
+
 	$req = GET 'http://localhost/', Accept => $xhtml;
 	$res = $cb->( $req );
 	is $res->code, 200, 'Post-modification leaves the status alone';