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 { $app->run_test_request(@_); }
  72
  73 ok my $get_landing = run_request(GET => 'http://localhost/' ),
  74   'got landing';
  75
  76 cmp_ok $get_landing->code, '==', 200,
  77   '200 on GET';
  78
  79 no strict 'refs';
  80
  81 {
  82     my ($self, $env, @noextra) = @{eval($get_landing->content)||[]};
  83     die $@ if $@;
  84     is scalar(@noextra), 0, 'No extra stuff';
  85     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
  86     is ref($env), 'HASH', 'Got hashref';
  87 }
  88
  89 ok my $get_users = run_request(GET => 'http://localhost/user'),
  90   'got user';
  91
  92 cmp_ok $get_users->code, '==', 200,
  93   '200 on GET';
  94
  95 {
  96     my ($self, $env, @noextra) = @{eval $get_users->content};
  97     is scalar(@noextra), 0, 'No extra stuff';
  98     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
  99     is ref($env), 'HASH', 'Got hashref';
 100 }
 101
 102 ok my $get_user = run_request(GET => 'http://localhost/user/42'),
 103   'got user';
 104
 105 cmp_ok $get_user->code, '==', 200,
 106   '200 on GET';
 107
 108 {
 109     my ($self, $env, @noextra) = @{eval $get_user->content};
 110     is scalar(@noextra), 0, 'No extra stuff';
 111     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
 112     is ref($env), 'HASH', 'Got hashref';
 113 }
 114
 115 ok my $post_user = run_request(POST => 'http://localhost/user/42', [id => '99'] ),
 116   'post user';
 117
 118 cmp_ok $post_user->code, '==', 200,
 119   '200 on POST';
 120
 121 {
 122     my ($self, $params, $env, @noextra) = @{eval $post_user->content};
 123     is scalar(@noextra), 0, 'No extra stuff';
 124     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
 125     is ref($params), 'HASH', 'Got POST hashref';
 126     is $params->{id}, 99, 'got expected value for id';
 127     is ref($env), 'HASH', 'Got hashref';
 128 }