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         return [
  38             200, ['Content-Type' => 'application/perl' ],
  39             [::Dumper \@args],
  40         ];
  41     }
  42     sub show_users {
  43         my ($self, @args) = @_;
  44         local $self->{_dispatcher};
  45         return [
  46             200, ['Content-Type' => 'application/perl' ],
  47             [::Dumper \@args],
  48         ];
  49     }
  50     sub show_user {
  51         my ($self, @args) = @_;
  52         local $self->{_dispatcher};
  53         return [
  54             200, ['Content-Type' => 'application/perl' ],
  55             [::Dumper \@args],
  56         ];
  57     }
  58     sub process_post {
  59         my ($self, @args) = @_;
  60         local $self->{_dispatcher};
  61         return [
  62             200, ['Content-Type' => 'application/perl' ],
  63             [::Dumper \@args],
  64         ];
  65     }
  66 }
  67
  68 ok my $app = t::Web::Simple::SubDispatchArgs->new,
  69   'made app';
  70
  71 sub run_request {
  72   my $request = shift;
  73   return test_psgi $app->to_psgi_app, sub { shift->($request) };
  74 }
  75
  76 use HTTP::Request::Common qw(GET POST);
  77
  78 ok my $get_landing = run_request(GET 'http://localhost/' ),
  79   'got landing';
  80
  81 cmp_ok $get_landing->code, '==', 200,
  82   '200 on GET';
  83
  84 no strict 'refs';
  85
  86 {
  87     my ($self, $env, @noextra) = @{eval($get_landing->content)||[]};
  88     die $@ if $@;
  89     is scalar(@noextra), 0, 'No extra stuff';
  90     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
  91     is ref($env), 'HASH', 'Got hashref';
  92 }
  93
  94 ok my $get_users = run_request(GET 'http://localhost/user'),
  95   'got user';
  96
  97 cmp_ok $get_users->code, '==', 200,
  98   '200 on GET';
  99
 100 {
 101     my ($self, $env, @noextra) = @{eval $get_users->content};
 102     is scalar(@noextra), 0, 'No extra stuff';
 103     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
 104     is ref($env), 'HASH', 'Got hashref';
 105 }
 106
 107 ok my $get_user = run_request(GET 'http://localhost/user/42'),
 108   'got user';
 109
 110 cmp_ok $get_user->code, '==', 200,
 111   '200 on GET';
 112
 113 {
 114     my ($self, $env, @noextra) = @{eval $get_user->content};
 115     is scalar(@noextra), 0, 'No extra stuff';
 116     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
 117     is ref($env), 'HASH', 'Got hashref';
 118 }
 119
 120 ok my $post_user = run_request(POST 'http://localhost/user/42', [id => '99'] ),
 121   'post user';
 122
 123 cmp_ok $post_user->code, '==', 200,
 124   '200 on POST';
 125
 126 {
 127     my ($self, $params, $env, @noextra) = @{eval $post_user->content};
 128     is scalar(@noextra), 0, 'No extra stuff';
 129     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
 130     is ref($params), 'HASH', 'Got POST hashref';
 131     is $params->{id}, 99, 'got expected value for id';
 132     is ref($env), 'HASH', 'Got hashref';
 133 }
 134