t/dispatch_misc.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3 no warnings::illegalproto;
   4
   5 use Test::More;
   6
   7 use HTTP::Request::Common qw(GET POST);
   8 use Web::Dispatch;
   9 use HTTP::Response;
  10 use Web::Dispatch::Predicates 'match_true';
  11
  12 my @dispatch;
  13
  14 {
  15     use Web::Simple 'MiscTest';
  16
  17     package MiscTest;
  18     sub dispatch_request { @dispatch }
  19     sub string_method { [ 999, [], [""] ]; }
  20
  21     sub can {
  22         die "Passed undef to can, this blows up on 5.8" unless defined($_[1]);
  23         shift->SUPER::can(@_)
  24     }
  25 }
  26
  27 my $app = MiscTest->new;
  28 sub run_request { $app->run_test_request( @_ ); }
  29
  30 string_method_name();
  31 app_is_non_plack();
  32 app_is_object();
  33 app_is_just_sub();
  34 plack_app_return();
  35 broken_route_def();
  36 invalid_psgi_responses();
  37 middleware_as_only_route();
  38 route_returns_middleware_plus_extra();
  39 route_returns_undef();
  40 matcher_nonsub_pair();
  41 matcher_undef_method();
  42
  43 done_testing();
  44
  45 sub string_method_name {
  46     @dispatch = ( '/' => "string_method" );
  47
  48     my $get = run_request( GET => 'http://localhost/' );
  49
  50     cmp_ok $get->code, '==', 999, "a dispatcher that's a string matching a method on the dispatch object gets executed";
  51 }
  52
  53 sub app_is_non_plack {
  54
  55     my $r = HTTP::Response->new( 999 );
  56
  57     my $d = Web::Dispatch->new( dispatch_app => $r );
  58     eval { $d->call };
  59
  60     like $@, qr/No idea how we got here with HTTP::Response/,
  61       "Web::Dispatch dies when run with an app() that is a non-PSGI object";
  62     undef $@;
  63 }
  64
  65 sub app_is_object {
  66     {
  67
  68         package ObjectApp;
  69         use Moo;
  70         sub to_app { [ 999, [], ["ok"] ] }
  71     }
  72
  73     my $o = ObjectApp->new;
  74     my $d = Web::Dispatch->new( dispatch_object => $o );
  75     my $res = $d->call;
  76
  77     cmp_ok $res->[0], '==', 999, "Web::Dispatch can dispatch properly, given only an object with to_app method";
  78 }
  79
  80 sub app_is_just_sub {
  81     my $d = Web::Dispatch->new( dispatch_app => sub () { [ 999, [], ["ok"] ] } );
  82     my $res = $d->call( {} );
  83
  84     cmp_ok $res->[0], '==', 999,
  85       "Web::Dispatch can dispatch properly, given only an app that's just a sub, with no object involved";
  86 }
  87
  88 sub plack_app_return {
  89     {
  90
  91         package FauxPlackApp;
  92         sub new { bless {}, $_[0] }
  93
  94         sub to_app {
  95             return sub {
  96                 [ 999, [], [""] ];
  97             };
  98         }
  99     }
 100
 101     @dispatch = (
 102         sub (/) {
 103             FauxPlackApp->new;
 104         }
 105     );
 106
 107     my $get = run_request( GET => 'http://localhost/' );
 108
 109     cmp_ok $get->code, '==', 999,
 110       "when a route returns a thing that look like a Plack app, the web app redispatches to that thing";
 111 }
 112
 113 sub broken_route_def {
 114
 115     @dispatch = ( '/' => "" );
 116
 117     my $get = run_request( GET => 'http://localhost/' );
 118
 119     cmp_ok $get->code, '==', 500, "a route definition by hash that doesn't pair a sub with a route dies";
 120     like $get->content, qr[No idea how we got here with /], "the error message points out the broken definition";
 121 }
 122
 123 sub invalid_psgi_responses {
 124     undef $@;
 125
 126     my @responses = (
 127         [ [ sub { } ], "an arrayref with a single sub in it" ],
 128         [ ["moo"], "an arrayref with a scalar that is not a sub" ],
 129         [ bless( {}, "FauxObject" ), "an object without to_app method" ],
 130     );
 131
 132     for my $response ( @responses ) {
 133         @dispatch = ( sub (/) { $response->[0] } );
 134
 135         my $message = sprintf(
 136             "if a route returns %s, then that is returned as a response by WD, causing HTTP::Message::PSGI to choke",
 137             $response->[1]
 138         );
 139
 140         # Somewhere between 1.0028 and 1.0031 Plack changed so that the
 141         # FauxObject case became a 500 rather than a die; in case it later does
 142         # the same thing for other stuff, just accept either sort of error
 143
 144         my $res = eval { run_request( GET => 'http://localhost/' ) };
 145
 146         if ($res) {
 147           ok $res->is_error, $message;
 148         } else {
 149           like $@, qr/Can't call method "request" on an undefined value .*MockHTTP/, $message;
 150         }
 151         undef $@;
 152     }
 153 }
 154
 155 sub middleware_as_only_route {
 156     @dispatch = ( bless {}, "Plack::Middleware" );
 157
 158     my $get = run_request( GET => 'http://localhost/' );
 159
 160     cmp_ok $get->code, '==', 500, "a route definition consisting of only a middleware causes a bail";
 161     like $get->content, qr[Multiple results but first one is a middleware \(Plack::Middleware=],
 162       "the error message mentions the middleware class";
 163 }
 164
 165 sub route_returns_middleware_plus_extra {
 166     @dispatch = (
 167         sub (/) {
 168             return ( bless( {}, "Plack::Middleware" ), "" );
 169         }
 170     );
 171
 172     my $get = run_request( GET => 'http://localhost/' );
 173
 174     cmp_ok $get->code, '==', 500, "a route returning a middleware and at least one other variable causes a bail";
 175     like $get->content,
 176       qr[Multiple results but first one is a middleware \(Plack::Middleware=],
 177       "the error message mentions the middleware class";
 178 }
 179
 180 sub route_returns_undef {
 181     @dispatch = (
 182         sub (/) {
 183             (
 184                 sub(/) {
 185                     undef;
 186                 },
 187                 sub(/) {
 188                     [ 900, [], [""] ];
 189                 }
 190             );
 191         },
 192         sub () {
 193             [ 400, [], [""] ];
 194         }
 195     );
 196
 197     my $get = run_request( GET => 'http://localhost/' );
 198
 199     cmp_ok $get->code, '==', 900, "a route that returns undef causes WD to ignore it and resume dispatching";
 200 }
 201
 202 sub matcher_nonsub_pair {
 203     @dispatch = ( match_true() => 5 );
 204
 205     my $get = run_request( GET => 'http://localhost/' );
 206
 207     cmp_ok $get->code, '==', 500, "a route definition that pairs a WD::Matcher a non-sub dies";
 208     like $get->content, qr[No idea how we got here with Web::Dispatch::M],
 209       "the error message points out the broken definition";
 210 }
 211
 212 sub matcher_undef_method {
 213     @dispatch = ( 'GET', undef );
 214
 215     my $get = run_request( GET => 'http://localhost/' );
 216
 217     cmp_ok $get->code, '==', 500, "a route definition that pairs a WD::Matcher a non-sub dies";
 218     like $get->content, qr[No idea how we got here with GET],
 219       "the error message points out the broken definition";
 220 }