1use strict; 2use warnings FATAL => 'all'; 3 4use Data::Dumper::Concise; 5use Test::More 'no_plan'; 6use Plack::Test; 7 8{ 9 use Web::Simple 't::Web::Simple::SubDispatchArgs'; 10 package t::Web::Simple::SubDispatchArgs; 11 12 has 'attr' => (is=>'ro'); 13 14 sub dispatch_request { 15 my $self = shift; 16 sub (/) { 17 $self->show_landing(@_); 18 }, 19 sub(/...) { 20 q(GET + /user) => sub { 21 $self->show_users(@_); 22 }, 23 sub (/user/*) { 24 sub (GET) { 25 $self->show_user(@_); 26 }, 27 sub (POST + %:id=&:@roles~) { 28 $self->process_post(@_); 29 } 30 }, 31 } 32 }; 33 34 sub show_landing { 35 my ($self, @args) = @_; 36 local $self->{_dispatcher}; 37 local $args[-1]->{'Web::Dispatch.original_env'}; 38 return [ 39 200, ['Content-Type' => 'application/perl' ], 40 [::Dumper \@args], 41 ]; 42 } 43 sub show_users { 44 my ($self, @args) = @_; 45 local $self->{_dispatcher}; 46 local $args[-1]->{'Web::Dispatch.original_env'}; 47 return [ 48 200, ['Content-Type' => 'application/perl' ], 49 [::Dumper \@args], 50 ]; 51 } 52 sub show_user { 53 my ($self, @args) = @_; 54 local $self->{_dispatcher}; 55 local $args[-1]->{'Web::Dispatch.original_env'}; 56 return [ 57 200, ['Content-Type' => 'application/perl' ], 58 [::Dumper \@args], 59 ]; 60 } 61 sub process_post { 62 my ($self, @args) = @_; 63 local $self->{_dispatcher}; 64 local $args[-1]->{'Web::Dispatch.original_env'}; 65 return [ 66 200, ['Content-Type' => 'application/perl' ], 67 [::Dumper \@args], 68 ]; 69 } 70} 71 72ok my $app = t::Web::Simple::SubDispatchArgs->new, 73 'made app'; 74 75sub run_request { $app->run_test_request(@_); } 76 77ok my $get_landing = run_request(GET => 'http://localhost/' ), 78 'got landing'; 79 80cmp_ok $get_landing->code, '==', 200, 81 '200 on GET'; 82 83no strict 'refs'; 84 85{ 86 my ($self, $env, @noextra) = @{eval($get_landing->content)||[]}; 87 die $@ if $@; 88 is scalar(@noextra), 0, 'No extra stuff'; 89 is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object'; 90 is ref($env), 'HASH', 'Got hashref'; 91} 92 93ok my $get_users = run_request(GET => 'http://localhost/user'), 94 'got user'; 95 96cmp_ok $get_users->code, '==', 200, 97 '200 on GET'; 98 99{ 100 my ($self, $env, @noextra) = @{eval $get_users->content}; 101 is scalar(@noextra), 0, 'No extra stuff'; 102 is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object'; 103 is ref($env), 'HASH', 'Got hashref'; 104} 105 106ok my $get_user = run_request(GET => 'http://localhost/user/42'), 107 'got user'; 108 109cmp_ok $get_user->code, '==', 200, 110 '200 on GET'; 111 112{ 113 my ($self, $env, @noextra) = @{eval $get_user->content}; 114 is scalar(@noextra), 0, 'No extra stuff'; 115 is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object'; 116 is ref($env), 'HASH', 'Got hashref'; 117} 118 119ok my $post_user = run_request(POST => 'http://localhost/user/42', [id => '99'] ), 120 'post user'; 121 122cmp_ok $post_user->code, '==', 200, 123 '200 on POST'; 124 125{ 126 my ($self, $params, $env, @noextra) = @{eval $post_user->content}; 127 is scalar(@noextra), 0, 'No extra stuff'; 128 is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object'; 129 is ref($params), 'HASH', 'Got POST hashref'; 130 is $params->{id}, 99, 'got expected value for id'; 131 is ref($env), 'HASH', 'Got hashref'; 132} 133