File Coverage

blib/lib/Plack/Middleware/Rewrite.pm

Criterion	Covered	Total	%
statement	62	65	95.3
branch	34	38	89.4
condition	11	15	73.3
subroutine	10	10	100.0
pod	1	1	100.0
total	118	129	91.4

use 5.006;
use strict;
use warnings;

package Plack::Middleware::Rewrite;
$Plack::Middleware::Rewrite::VERSION = '2.101';
# ABSTRACT: mod_rewrite for Plack

use parent 'Plack::Middleware';

use Plack::Util::Accessor qw( request response rules );
use Plack::Request ();
use Plack::Util ();
use overload ();

sub call {
	my $self = shift;
	my ( $env ) = @_;

	my ( $app, $res, $legacy );
	my ( $rules, $modify_cb ) = ( $self->request, $self->response );

	unless ( $rules or $modify_cb ) {
		$rules = $self->rules;
		$legacy = 1;
	}

	# call rules with $_ aliased to PATH_INFO
	( $res ) = map { scalar $rules->( $env ) } $env->{'PATH_INFO'}
		if $rules;

	if ( $legacy ) {
		if    ( 'CODE'  eq ref $res ) { ( $modify_cb, $res ) = $res }
		elsif ( 'ARRAY' eq ref $res ) { undef $res if not @$res }
		elsif ( ref $res )            { undef $res }
		else {
			# upgrade scalar to response if it looks like an HTTP status
			$res = ( defined $res and $res =~ /\A[1-5][0-9][0-9]\z/ )
				? [ $res, [], [] ]
				: undef;
		}
	}
	else {
		if    ( 'CODE'  eq ref $res ) { ( $app, $res ) = $res }
		elsif ( 'ARRAY' eq ref $res ) { @$res = ( 303, [], [] ) if not @$res }
		elsif ( ref $res )            { die 'Unhandled reference type in request rewrite: ', overload::StrVal( $res ), "\n" }
		else                          { undef $res }
	}

	if ( $res ) { # external redirect, or explicit response
		push @$res, map { [] } @$res .. 2;

		if ( $res->[0] =~ /\A3[0-9][0-9]\z/ ) {
			my $dest = Plack::Util::header_get( $res->[1], 'Location' );
			if ( not $dest ) {
				$dest = Plack::Request->new( $env )->uri;
				Plack::Util::header_set( $res->[1], Location => $dest );
			}

			if ( 304 ne $res->[0] and not (
				Plack::Util::content_length( $res->[2] )
				or Plack::Util::header_exists( $res->[1], 'Content-Length' )
			) ) {
				my $href = Plack::Util::encode_html( $dest );
				Plack::Util::header_set( $res->[1], qw( Content-Type text/html ) );
				$res->[2] = [ qq'MovedThis resource has moved to a new address.' ];
			}
		}
	}
	else { # internal redirect
		$app ||= $self->app;
		$res = $app->( $env );
	}

	return $res if not $modify_cb;
	Plack::Util::response_cb( $res, sub {
		my $response = $_[0];
		my $hdrs = Plack::Util::headers( $response->[1] );
		$hdrs->{'status'} = sub { @_ ? $response->[0] = $_[0] : $response->[0] };
		my ( $result ) = map $modify_cb->( $env ), $hdrs;
		return 'CODE' eq ref $result ? $result : ();
	} );
}

1;

__END__