t/sub-dispatch-args.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3
   4 use Data::Dumper::Concise;
   5 use Test::More 'no_plan';
   6 use 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
  72 ok my $app = t::Web::Simple::SubDispatchArgs->new,
  73   'made app';
  74
  75 sub run_request { $app->run_test_request(@_); }
  76
  77 ok my $get_landing = run_request(GET => 'http://localhost/' ),
  78   'got landing';
  79
  80 cmp_ok $get_landing->code, '==', 200,
  81   '200 on GET';
  82
  83 no 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
  93 ok my $get_users = run_request(GET => 'http://localhost/user'),
  94   'got user';
  95
  96 cmp_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
 106 ok my $get_user = run_request(GET => 'http://localhost/user/42'),
 107   'got user';
 108
 109 cmp_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
 119 ok my $post_user = run_request(POST => 'http://localhost/user/42', [id => '99'] ),
 120   'post user';
 121
 122 cmp_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 }