X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fsub-dispatch-args.t;h=8812595dba9acda1cedbd630e23bde139c377036;hb=1bba6f8837b67795b5a9c215e9158d4defa81461;hp=c7b5830d1c065c54644348a060fd32890353d56d;hpb=48cab33d066488eabe275c2842b3a5feaaa83043;p=catagits%2FWeb-Simple.git diff --git a/t/sub-dispatch-args.t b/t/sub-dispatch-args.t index c7b5830..8812595 100644 --- a/t/sub-dispatch-args.t +++ b/t/sub-dispatch-args.t @@ -1,24 +1,23 @@ use strict; use warnings FATAL => 'all'; -use Data::Dump qw(dump); -use Test::More ( - eval { require HTTP::Request::AsCGI } - ? 'no_plan' - : (skip_all => 'No HTTP::Request::AsCGI') -); +use Data::Dumper::Concise; +use Test::More 'no_plan'; +use Plack::Test; { use Web::Simple 't::Web::Simple::SubDispatchArgs'; package t::Web::Simple::SubDispatchArgs; + has 'attr' => (is=>'ro'); + sub dispatch_request { my $self = shift; sub (/) { $self->show_landing(@_); }, sub(/...) { - sub (GET + /user) { + q(GET + /user) => sub { $self->show_users(@_); }, sub (/user/*) { @@ -34,30 +33,34 @@ use Test::More ( sub show_landing { my ($self, @args) = @_; + local $self->{_dispatcher}; return [ 200, ['Content-Type' => 'application/perl' ], - [Data::Dump::dump @args], + [::Dumper \@args], ]; } sub show_users { my ($self, @args) = @_; + local $self->{_dispatcher}; return [ 200, ['Content-Type' => 'application/perl' ], - [Data::Dump::dump @args], + [::Dumper \@args], ]; } sub show_user { my ($self, @args) = @_; + local $self->{_dispatcher}; return [ 200, ['Content-Type' => 'application/perl' ], - [Data::Dump::dump @args], + [::Dumper \@args], ]; } sub process_post { my ($self, @args) = @_; + local $self->{_dispatcher}; return [ 200, ['Content-Type' => 'application/perl' ], - [Data::Dump::dump @args], + [::Dumper \@args], ]; } } @@ -65,71 +68,62 @@ use Test::More ( ok my $app = t::Web::Simple::SubDispatchArgs->new, 'made app'; -sub run_request { - my @args = (shift, SCRIPT_NAME=> $0); - my $c = HTTP::Request::AsCGI->new(@args)->setup; - $app->run; - $c->restore; - return $c->response; -} - -use HTTP::Request::Common qw(GET POST); +sub run_request { $app->run_test_request(@_); } -ok my $get_landing = run_request(GET 'http://localhost/' ), +ok my $get_landing = run_request(GET => 'http://localhost/' ), 'got landing'; cmp_ok $get_landing->code, '==', 200, '200 on GET'; +no strict 'refs'; + { - my ($self, $env, @noextra) = eval $get_landing->content; + my ($self, $env, @noextra) = @{eval($get_landing->content)||[]}; + die $@ if $@; is scalar(@noextra), 0, 'No extra stuff'; is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object'; is ref($env), 'HASH', 'Got hashref'; - is $env->{SCRIPT_NAME}, $0, 'correct scriptname'; } -ok my $get_users = run_request(GET 'http://localhost/user'), +ok my $get_users = run_request(GET => 'http://localhost/user'), 'got user'; cmp_ok $get_users->code, '==', 200, '200 on GET'; { - my ($self, $env, @noextra) = eval $get_users->content; + my ($self, $env, @noextra) = @{eval $get_users->content}; is scalar(@noextra), 0, 'No extra stuff'; is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object'; is ref($env), 'HASH', 'Got hashref'; - is $env->{SCRIPT_NAME}, $0, 'correct scriptname'; } -ok my $get_user = run_request(GET 'http://localhost/user/42'), +ok my $get_user = run_request(GET => 'http://localhost/user/42'), 'got user'; cmp_ok $get_user->code, '==', 200, '200 on GET'; { - my ($self, $env, @noextra) = eval $get_user->content; + my ($self, $env, @noextra) = @{eval $get_user->content}; is scalar(@noextra), 0, 'No extra stuff'; is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object'; is ref($env), 'HASH', 'Got hashref'; - is $env->{SCRIPT_NAME}, $0, 'correct scriptname'; } -ok my $post_user = run_request(POST 'http://localhost/user/42', [id => '99'] ), +ok my $post_user = run_request(POST => 'http://localhost/user/42', [id => '99'] ), 'post user'; cmp_ok $post_user->code, '==', 200, '200 on POST'; { - my ($self, $params, $env, @noextra) = eval $post_user->content; + my ($self, $params, $env, @noextra) = @{eval $post_user->content}; is scalar(@noextra), 0, 'No extra stuff'; is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object'; is ref($params), 'HASH', 'Got POST hashref'; is $params->{id}, 99, 'got expected value for id'; is ref($env), 'HASH', 'Got hashref'; - is $env->{SCRIPT_NAME}, $0, 'correct scriptname'; }