elsif (ref($first) eq 'HASH' and $first->{+MAGIC_MIDDLEWARE_KEY}) {
return $self->_redispatch_with_middleware($first, $match, $env);
}
- elsif (blessed($first) && !$first->can('to_app')) {
+ elsif (
+ blessed($first) &&
+ not($first->can('to_app')) &&
+ not($first->isa('Web::Dispatch::Matcher'))
+ ) {
return $first;
}
-
return;
}
# sub (<spec>) {} becomes a dispatcher
# sub {} is a PSGI app and can be returned as is
# '<spec>' => sub {} becomes a dispatcher
+ # $obj isa WD:Predicates::Proxy => sub { ... } - become a dispatcher
# $obj w/to_app method is a Plack::App-like thing - call it to get a PSGI app
+ #
if (ref($try) eq 'CODE') {
if (defined(my $proto = prototype($try))) {
}
} elsif (!ref($try) and ref($more->[0]) eq 'CODE') {
$self->_construct_node(match => $try, run => shift(@$more))->to_app;
+ } elsif (
+ (blessed($try) && $try->isa('Web::Dispatch::Matcher'))
+ and (ref($more->[0]) eq 'CODE')
+ ) {
+ $self->node_class->new({
+ %{$self->node_args},
+ match => $try,
+ run => shift(@$more)
+ })->to_app;
} elsif (blessed($try) && $try->can('to_app')) {
$try->to_app;
} else {
match_extension match_query match_body match_uploads
);
+sub _generate_proxy { bless shift, 'Web::Dispatch::Matcher' }
+
sub match_and {
my @match = @_;
- sub {
+ _generate_proxy(sub {
my ($env) = @_;
my $my_env = { 'Web::Dispatch.original_env' => $env, %$env };
my $new_env;
}
}
return ($new_env, @got);
- }
+ })
}
sub match_or {
my @match = @_;
- sub {
+ _generate_proxy(sub {
foreach my $try (@match) {
if (my @ret = $try->(@_)) {
return @ret;
}
}
return;
- }
+ })
}
sub match_not {
my ($match) = @_;
- sub {
+ _generate_proxy(sub {
if (my @discard = $match->($_[0])) {
();
} else {
({});
}
- }
+ })
}
sub match_method {
my ($method) = @_;
- sub {
+ _generate_proxy(sub {
my ($env) = @_;
$env->{REQUEST_METHOD} eq $method ? {} : ()
- }
+ })
}
sub match_path {
my ($re) = @_;
- sub {
+ _generate_proxy(sub {
my ($env) = @_;
if (my @cap = ($env->{PATH_INFO} =~ /$re/)) {
$cap[0] = {}; return @cap;
}
return;
- }
+ })
}
sub match_path_strip {
my ($re) = @_;
- sub {
+ _generate_proxy(sub {
my ($env) = @_;
if (my @cap = ($env->{PATH_INFO} =~ /$re/)) {
$cap[0] = {
return @cap;
}
return;
- }
+ })
}
sub match_extension {
my $re = $wild
? qr/\.(\w+)$/
: qr/\.(\Q${extension}\E)$/;
- sub {
+ _generate_proxy(sub {
if ($_[0]->{PATH_INFO} =~ $re) {
($wild ? ({}, $1) : {});
} else {
();
}
- };
+ });
}
sub match_query {
- _param_matcher(query => $_[0]);
+ _generate_proxy(_param_matcher(query => $_[0]));
}
sub match_body {
- _param_matcher(body => $_[0]);
+ _generate_proxy(_param_matcher(body => $_[0]));
}
sub match_uploads {
- _param_matcher(uploads => $_[0]);
+ _generate_proxy(_param_matcher(uploads => $_[0]));
}
sub _param_matcher {
--- /dev/null
+use strict;
+use warnings FATAL => 'all';
+
+use Data::Dumper::Concise;
+use Test::More 'no_plan';
+use Plack::Test;
+
+{
+ use Web::Simple 't::Web::Simple::SubDispatchArgs';
+ package t::Web::Simple::SubDispatchArgs;
+ use Web::Dispatch::Predicates;
+
+ has 'attr' => (is=>'ro');
+
+ sub dispatch_request {
+ my $self = shift;
+ match_path(qr/(?^:^(\/)$)/), sub {
+ $self->show_landing(@_);
+ },
+ match_path_strip(qr/(?^:^()(\/.*)$)/) => sub {
+ match_and
+ (
+ match_method('GET'),
+ match_path(qr/(?^:^(\/user(?:\.\w+)?)$)/)
+ ) => sub {
+ $self->show_users(@_);
+ },
+ match_path(qr/(?^:^(\/user\/([^\/]+?)(?:\.\w+)?)$)/), sub {
+ match_method('GET') => sub {
+ $self->show_user(@_);
+ },
+ match_and
+ (
+ match_method('POST'),
+ match_body
+ ({
+ named => [
+ {
+ multi => "",
+ name => "id"
+ },
+ {
+ multi => 1,
+ name => "roles"
+ }
+ ],
+ required => ["id"]
+ })
+ ) => sub {
+ $self->process_post(@_);
+ }
+ },
+ }
+ };
+
+ sub show_landing {
+ my ($self, @args) = @_;
+ local $self->{_dispatcher};
+ local $args[-1]->{'Web::Dispatch.original_env'};
+ return [
+ 200, ['Content-Type' => 'application/perl' ],
+ [::Dumper \@args],
+ ];
+ }
+ sub show_users {
+ my ($self, @args) = @_;
+ local $self->{_dispatcher};
+ local $args[-1]->{'Web::Dispatch.original_env'};
+ return [
+ 200, ['Content-Type' => 'application/perl' ],
+ [::Dumper \@args],
+ ];
+ }
+ sub show_user {
+ my ($self, @args) = @_;
+ local $self->{_dispatcher};
+ local $args[-1]->{'Web::Dispatch.original_env'};
+ return [
+ 200, ['Content-Type' => 'application/perl' ],
+ [::Dumper \@args],
+ ];
+ }
+ sub process_post {
+ my ($self, @args) = @_;
+ local $self->{_dispatcher};
+ local $args[-1]->{'Web::Dispatch.original_env'};
+ return [
+ 200, ['Content-Type' => 'application/perl' ],
+ [::Dumper \@args],
+ ];
+ }
+}
+
+ok my $app = t::Web::Simple::SubDispatchArgs->new,
+ 'made app';
+
+sub run_request { $app->run_test_request(@_); }
+
+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)||[]};
+ die $@ if $@;
+ is scalar(@noextra), 0, 'No extra stuff';
+ is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
+ is ref($env), 'HASH', 'Got hashref';
+}
+
+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};
+ is scalar(@noextra), 0, 'No extra stuff';
+ is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
+ is ref($env), 'HASH', 'Got hashref';
+}
+
+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};
+ is scalar(@noextra), 0, 'No extra stuff';
+ is ref($self), 't::Web::Simple::SubDispatchArgs', 'got object';
+ is ref($env), 'HASH', 'Got hashref';
+}
+
+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};
+ 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';
+}
projects / catagits/Web-Simple.git / commitdiff