X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fsub-dispatch-args.t;h=8812595dba9acda1cedbd630e23bde139c377036;hb=1bba6f8837b67795b5a9c215e9158d4defa81461;hp=781fbf4416edf02659c664b82e42424f0b327694;hpb=6e42ffdef869704885d9c3e002ef97e063e2d411;p=catagits%2FWeb-Simple.git

diff --git a/t/sub-dispatch-args.t b/t/sub-dispatch-args.t
index 781fbf4..8812595 100644
--- a/t/sub-dispatch-args.t
+++ b/t/sub-dispatch-args.t
@@ -1,31 +1,31 @@
 use strict;
 use warnings FATAL => 'all';
 
-use Data::Dump qw(dump);
-use Test::More (
-  eval { require HTTP::Request::AsCGI }
-    ? 'no_plan'
-    : (skip_all => 'No HTTP::Request::AsCGI')
-);
+use Data::Dumper::Concise;
+use Test::More 'no_plan';
+use Plack::Test;
 
 {
     use Web::Simple 't::Web::Simple::SubDispatchArgs';
     package t::Web::Simple::SubDispatchArgs;
 
+    has 'attr' => (is=>'ro');
+
     sub dispatch_request {
+        my $self = shift;
         sub (/) {
-            $_[0]->show_landing(@_);
+            $self->show_landing(@_);
         },
         sub(/...) {
-            sub (GET + /user) {
-                $_[0]->show_users(@_);
+            q(GET + /user) => sub {
+                $self->show_users(@_);
             },
             sub (/user/*) {
                 sub (GET) {
-                    $_[0]->show_user(@_);
+                    $self->show_user(@_);
                 },
                 sub (POST + %:id=&:@roles~) {
-                    $_[0]->process_post(@_);
+                    $self->process_post(@_);
                 }
             },
         }
@@ -33,30 +33,34 @@ use Test::More (
 
     sub show_landing {
         my ($self, @args) = @_;
+        local $self->{_dispatcher};
         return [
             200, ['Content-Type' => 'application/perl' ],
-            [Data::Dump::dump @args],
+            [::Dumper \@args],
         ];
     }
     sub show_users {
         my ($self, @args) = @_;
+        local $self->{_dispatcher};
         return [
             200, ['Content-Type' => 'application/perl' ],
-            [Data::Dump::dump @args],
+            [::Dumper \@args],
         ];
     }
     sub show_user {
         my ($self, @args) = @_;
+        local $self->{_dispatcher};
         return [
             200, ['Content-Type' => 'application/perl' ],
-            [Data::Dump::dump @args],
+            [::Dumper \@args],
         ];
     }
     sub process_post {
         my ($self, @args) = @_;
+        local $self->{_dispatcher};
         return [
             200, ['Content-Type' => 'application/perl' ],
-            [Data::Dump::dump @args],
+            [::Dumper \@args],
         ];
     }
 }
@@ -64,71 +68,62 @@ use Test::More (
 ok my $app = t::Web::Simple::SubDispatchArgs->new,
   'made app';
 
-sub run_request {
-  my @args = (shift, SCRIPT_NAME=> $0);
-  my $c = HTTP::Request::AsCGI->new(@args)->setup;
-  $app->run;
-  $c->restore;
-  return $c->response;
-}
-
-use HTTP::Request::Common qw(GET POST);
+sub run_request { $app->run_test_request(@_); }
 
-ok my $get_landing = run_request(GET 'http://localhost/' ),
+ok my $get_landing = run_request(GET => 'http://localhost/' ),
   'got landing';
 
 cmp_ok $get_landing->code, '==', 200, 
   '200 on GET';
 
+no strict 'refs';
+
 {
-    my ($self, $env, @noextra) = eval $get_landing->content;
+    my ($self, $env, @noextra) = @{eval($get_landing->content)||[]};
+    die $@ if $@;
     is scalar(@noextra), 0, 'No extra stuff';
     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
     is ref($env), 'HASH', 'Got hashref';
-    is $env->{SCRIPT_NAME}, $0, 'correct scriptname';
 }
 
-ok my $get_users = run_request(GET 'http://localhost/user'),
+ok my $get_users = run_request(GET => 'http://localhost/user'),
   'got user';
 
 cmp_ok $get_users->code, '==', 200, 
   '200 on GET';
 
 {
-    my ($self, $env, @noextra) = eval $get_users->content;
+    my ($self, $env, @noextra) = @{eval $get_users->content};
     is scalar(@noextra), 0, 'No extra stuff';
     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
     is ref($env), 'HASH', 'Got hashref';
-    is $env->{SCRIPT_NAME}, $0, 'correct scriptname';
 }
 
-ok my $get_user = run_request(GET 'http://localhost/user/42'),
+ok my $get_user = run_request(GET => 'http://localhost/user/42'),
   'got user';
 
 cmp_ok $get_user->code, '==', 200, 
   '200 on GET';
 
 {
-    my ($self, $env, @noextra) = eval $get_user->content;
+    my ($self, $env, @noextra) = @{eval $get_user->content};
     is scalar(@noextra), 0, 'No extra stuff';
     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
     is ref($env), 'HASH', 'Got hashref';
-    is $env->{SCRIPT_NAME}, $0, 'correct scriptname';
 }
 
-ok my $post_user = run_request(POST 'http://localhost/user/42', [id => '99'] ),
+ok my $post_user = run_request(POST => 'http://localhost/user/42', [id => '99'] ),
   'post user';
 
 cmp_ok $post_user->code, '==', 200, 
   '200 on POST';
 
 {
-    my ($self, $params, $env, @noextra) = eval $post_user->content;
+    my ($self, $params, $env, @noextra) = @{eval $post_user->content};
     is scalar(@noextra), 0, 'No extra stuff';
     is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
     is ref($params), 'HASH', 'Got POST hashref';
     is $params->{id}, 99, 'got expected value for id';
     is ref($env), 'HASH', 'Got hashref';
-    is $env->{SCRIPT_NAME}, $0, 'correct scriptname';
 }