removed frankensteining remnant
[catagits/Web-Simple.git] / lib / Web / Dispatch.pm
CommitLineData
4ed4fb42 1package Web::Dispatch;
2
3use Sub::Quote;
4use Scalar::Util qw(blessed);
1f4dd6f9 5
6sub MAGIC_MIDDLEWARE_KEY { __PACKAGE__.'.middleware' }
7
4ed4fb42 8use Moo;
9use Web::Dispatch::Parser;
10use Web::Dispatch::Node;
11
12with 'Web::Dispatch::ToApp';
13
14has app => (is => 'ro', required => 1);
15has parser_class => (
16 is => 'ro', default => quote_sub q{ 'Web::Dispatch::Parser' }
17);
18has node_class => (
19 is => 'ro', default => quote_sub q{ 'Web::Dispatch::Node' }
20);
21has node_args => (is => 'ro', default => quote_sub q{ {} });
22has _parser => (is => 'lazy');
23
24sub _build__parser {
25 my ($self) = @_;
26 $self->parser_class->new;
27}
28
29sub call {
30 my ($self, $env) = @_;
1a0ea82a 31 my $res = $self->_dispatch($env, $self->app);
32 return $res->[0] if ref($res) eq 'ARRAY' and @{$res} == 1 and ref($res->[0]) eq 'CODE';
33 return $res;
4ed4fb42 34}
35
36sub _dispatch {
37 my ($self, $env, @match) = @_;
59ccc1e8 38 while (defined(my $try = shift @match)) {
75ad66d6 39
40 return $try if ref($try) eq 'ARRAY';
4ed4fb42 41 if (ref($try) eq 'HASH') {
d96756e8 42 $env = { 'Web::Dispatch.original_env' => $env, %$env, %$try };
4ed4fb42 43 next;
4ed4fb42 44 }
75ad66d6 45
69aaa28a 46 my @result = $self->_to_try($try, \@match)->($env, @match);
4ed4fb42 47 next unless @result and defined($result[0]);
75ad66d6 48
49 my $first = $result[0];
e4c7f3b4 50
6cf1d73a 51 if (my $res = $self->_have_result($first, \@result, \@match, $env)) {
e4c7f3b4 52
53 return $res;
54 }
75ad66d6 55
56 # make a copy so we don't screw with it assigning further up
57 my $env = $env;
58 unshift @match, sub { $self->_dispatch($env, @result) };
4ed4fb42 59 }
75ad66d6 60
4ed4fb42 61 return;
62}
63
e4c7f3b4 64sub _have_result {
6cf1d73a 65 my ($self, $first, $result, $match, $env) = @_;
6bd99619 66
6cf1d73a 67 if (ref($first) eq 'ARRAY') {
1a0ea82a 68 return $first;
6bd99619 69 }
6cf1d73a 70 elsif (blessed($first) && $first->isa('Plack::Middleware')) {
71 return $self->_uplevel_middleware($first, $result);
6bd99619 72 }
6cf1d73a 73 elsif (ref($first) eq 'HASH' and $first->{+MAGIC_MIDDLEWARE_KEY}) {
74 return $self->_redispatch_with_middleware($first, $match, $env);
6bd99619 75 }
6cf1d73a 76 elsif (blessed($first) && !$first->can('to_app')) {
6bd99619 77 return $first;
78 }
79
80 return;
81}
82
e4c7f3b4 83sub _uplevel_middleware {
6cf1d73a 84 my ($self, $match, $results) = @_;
75ad66d6 85 die "Multiple results but first one is a middleware ($match)"
86 if @{$results} > 1;
87 # middleware needs to uplevel exactly once to wrap the rest of the
88 # level it was created for - next elsif unwraps it
89 return { MAGIC_MIDDLEWARE_KEY, $match };
90}
91
e4c7f3b4 92sub _redispatch_with_middleware {
6cf1d73a 93 my ($self, $first, $match, $env) = @_;
75ad66d6 94
95 my $mw = $first->{+MAGIC_MIDDLEWARE_KEY};
96
97 $mw->app(sub { $self->_dispatch($_[0], @{$match}) });
98
99 return $mw->to_app->($env);
100}
101
4ed4fb42 102sub _to_try {
69aaa28a 103 my ($self, $try, $more) = @_;
c398ce1a 104
105 # sub (<spec>) {} becomes a dispatcher
106 # sub {} is a PSGI app and can be returned as is
107 # '<spec>' => sub {} becomes a dispatcher
108 # $obj w/to_app method is a Plack::App-like thing - call it to get a PSGI app
109
4ed4fb42 110 if (ref($try) eq 'CODE') {
111 if (defined(my $proto = prototype($try))) {
e251dfeb 112 $self->_construct_node(match => $proto, run => $try)->to_app;
4ed4fb42 113 } else {
114 $try
115 }
69aaa28a 116 } elsif (!ref($try) and ref($more->[0]) eq 'CODE') {
e251dfeb 117 $self->_construct_node(match => $try, run => shift(@$more))->to_app;
4ed4fb42 118 } elsif (blessed($try) && $try->can('to_app')) {
119 $try->to_app;
120 } else {
121 die "No idea how we got here with $try";
122 }
123}
124
125sub _construct_node {
126 my ($self, %args) = @_;
e251dfeb 127 $args{match} = $self->_parser->parse($args{match});
69aaa28a 128 $self->node_class->new({ %{$self->node_args}, %args });
4ed4fb42 129}
130
1311;