[catagits/Web-Simple.git] / t / sub-dispatch-env.t

use strictures 1;
use Test::More 0.88;

{
  package TestApp;

  use Web::Simple;

  sub dispatch_request {
    sub (/foo/...) {
      sub (GET) { [ 200, [], [ $_[PSGI_ENV]->{PATH_INFO} ] ] }
    },
    sub (POST) { [ 200, [], [ $_[PSGI_ENV]->{PATH_INFO} ] ] }
  }
}

my $app = TestApp->new->to_psgi_app;

my $call = sub { $app->({
  SCRIPT_NAME => '/base', PATH_INFO => '/foo/bar', REQUEST_METHOD => shift
})->[2]->[0] };

is($call->('GET'), '/bar', 'recursive strip ok');
is($call->('POST'), '/foo/bar', 'later dispatchers unaffected');

done_testing;
Commit	Line	Data
1f4dd6f9	1	use strictures 1;
a30328b3	2	use Test::More 0.88;
1f4dd6f9	3
	4	{
	5	package TestApp;
	6
	7	use Web::Simple;
	8
	9	sub dispatch_request {
	10	sub (/foo/...) {
	11	sub (GET) { [ 200, [], [ $_[PSGI_ENV]->{PATH_INFO} ] ] }
	12	},
	13	sub (POST) { [ 200, [], [ $_[PSGI_ENV]->{PATH_INFO} ] ] }
	14	}
	15	}
	16
	17	my $app = TestApp->new->to_psgi_app;
	18
	19	my $call = sub { $app->({
	20	SCRIPT_NAME => '/base', PATH_INFO => '/foo/bar', REQUEST_METHOD => shift
	21	})->[2]->[0] };
	22
	23	is($call->('GET'), '/bar', 'recursive strip ok');
	24	is($call->('POST'), '/foo/bar', 'later dispatchers unaffected');
	25
	26	done_testing;