Commit | Line | Data |
4ed4fb42 |
1 | package Web::Dispatch; |
2 | |
3 | use Sub::Quote; |
4 | use Scalar::Util qw(blessed); |
1f4dd6f9 |
5 | |
6 | sub MAGIC_MIDDLEWARE_KEY { __PACKAGE__.'.middleware' } |
7 | |
4ed4fb42 |
8 | use Moo; |
9 | use Web::Dispatch::Parser; |
10 | use Web::Dispatch::Node; |
11 | |
12 | with 'Web::Dispatch::ToApp'; |
13 | |
e5250d96 |
14 | has dispatch_app => ( |
15 | is => 'lazy', builder => sub { shift->dispatch_object->to_app } |
16 | ); |
1f727762 |
17 | has dispatch_object => (is => 'ro', required => 0, weak_ref => 1); |
4ed4fb42 |
18 | has parser_class => ( |
19 | is => 'ro', default => quote_sub q{ 'Web::Dispatch::Parser' } |
20 | ); |
21 | has node_class => ( |
22 | is => 'ro', default => quote_sub q{ 'Web::Dispatch::Node' } |
23 | ); |
4ed4fb42 |
24 | has _parser => (is => 'lazy'); |
25 | |
e5250d96 |
26 | after BUILDARGS => sub { |
27 | my ( $self, %args ) = @_; |
28 | die "Either dispatch_app or dispatch_object need to be supplied." |
29 | if !$args{dispatch_app} and !$args{dispatch_object} |
30 | }; |
31 | |
4ed4fb42 |
32 | sub _build__parser { |
33 | my ($self) = @_; |
34 | $self->parser_class->new; |
35 | } |
36 | |
37 | sub call { |
38 | my ($self, $env) = @_; |
e5250d96 |
39 | my $res = $self->_dispatch($env, $self->dispatch_app); |
1a0ea82a |
40 | return $res->[0] if ref($res) eq 'ARRAY' and @{$res} == 1 and ref($res->[0]) eq 'CODE'; |
fd472484 |
41 | if (ref($res) eq 'HASH') { |
42 | $res = [ 200, [], $res ]; |
43 | } |
44 | if (ref($res) eq 'ARRAY' and ref($res->[2]) eq 'HASH') { |
45 | require JSON::MaybeXS; |
46 | $res = [ |
47 | $res->[0], |
48 | [ 'Content-type' => 'application/json', @{$res->[1]} ], |
49 | [ JSON::MaybeXS::encode_json($res->[2]) ], |
50 | ]; |
51 | } |
1a0ea82a |
52 | return $res; |
4ed4fb42 |
53 | } |
54 | |
55 | sub _dispatch { |
56 | my ($self, $env, @match) = @_; |
59ccc1e8 |
57 | while (defined(my $try = shift @match)) { |
75ad66d6 |
58 | |
59 | return $try if ref($try) eq 'ARRAY'; |
4ed4fb42 |
60 | if (ref($try) eq 'HASH') { |
d96756e8 |
61 | $env = { 'Web::Dispatch.original_env' => $env, %$env, %$try }; |
4ed4fb42 |
62 | next; |
4ed4fb42 |
63 | } |
75ad66d6 |
64 | |
69aaa28a |
65 | my @result = $self->_to_try($try, \@match)->($env, @match); |
4ed4fb42 |
66 | next unless @result and defined($result[0]); |
75ad66d6 |
67 | |
68 | my $first = $result[0]; |
e4c7f3b4 |
69 | |
6cf1d73a |
70 | if (my $res = $self->_have_result($first, \@result, \@match, $env)) { |
e4c7f3b4 |
71 | |
72 | return $res; |
73 | } |
75ad66d6 |
74 | |
75 | # make a copy so we don't screw with it assigning further up |
76 | my $env = $env; |
77 | unshift @match, sub { $self->_dispatch($env, @result) }; |
4ed4fb42 |
78 | } |
75ad66d6 |
79 | |
4ed4fb42 |
80 | return; |
81 | } |
82 | |
e4c7f3b4 |
83 | sub _have_result { |
6cf1d73a |
84 | my ($self, $first, $result, $match, $env) = @_; |
6bd99619 |
85 | |
6cf1d73a |
86 | if (ref($first) eq 'ARRAY') { |
1a0ea82a |
87 | return $first; |
6bd99619 |
88 | } |
6cf1d73a |
89 | elsif (blessed($first) && $first->isa('Plack::Middleware')) { |
90 | return $self->_uplevel_middleware($first, $result); |
6bd99619 |
91 | } |
6cf1d73a |
92 | elsif (ref($first) eq 'HASH' and $first->{+MAGIC_MIDDLEWARE_KEY}) { |
93 | return $self->_redispatch_with_middleware($first, $match, $env); |
6bd99619 |
94 | } |
481da1e2 |
95 | elsif ( |
96 | blessed($first) && |
97 | not($first->can('to_app')) && |
98 | not($first->isa('Web::Dispatch::Matcher')) |
99 | ) { |
6bd99619 |
100 | return $first; |
101 | } |
6bd99619 |
102 | return; |
103 | } |
104 | |
e4c7f3b4 |
105 | sub _uplevel_middleware { |
6cf1d73a |
106 | my ($self, $match, $results) = @_; |
75ad66d6 |
107 | die "Multiple results but first one is a middleware ($match)" |
108 | if @{$results} > 1; |
109 | # middleware needs to uplevel exactly once to wrap the rest of the |
110 | # level it was created for - next elsif unwraps it |
111 | return { MAGIC_MIDDLEWARE_KEY, $match }; |
112 | } |
113 | |
e4c7f3b4 |
114 | sub _redispatch_with_middleware { |
6cf1d73a |
115 | my ($self, $first, $match, $env) = @_; |
75ad66d6 |
116 | |
117 | my $mw = $first->{+MAGIC_MIDDLEWARE_KEY}; |
118 | |
119 | $mw->app(sub { $self->_dispatch($_[0], @{$match}) }); |
120 | |
121 | return $mw->to_app->($env); |
122 | } |
123 | |
4ed4fb42 |
124 | sub _to_try { |
69aaa28a |
125 | my ($self, $try, $more) = @_; |
c398ce1a |
126 | |
127 | # sub (<spec>) {} becomes a dispatcher |
128 | # sub {} is a PSGI app and can be returned as is |
129 | # '<spec>' => sub {} becomes a dispatcher |
456dc2bb |
130 | # $obj isa WD:Predicates::Matcher => sub { ... } - become a dispatcher |
c398ce1a |
131 | # $obj w/to_app method is a Plack::App-like thing - call it to get a PSGI app |
481da1e2 |
132 | # |
c398ce1a |
133 | |
4ed4fb42 |
134 | if (ref($try) eq 'CODE') { |
135 | if (defined(my $proto = prototype($try))) { |
79dda56f |
136 | $self->_construct_node(match => $proto, run => $try); |
4ed4fb42 |
137 | } else { |
138 | $try |
139 | } |
b2e37c62 |
140 | } elsif (!ref($try) |
141 | and (ref($more->[0]) eq 'CODE' |
142 | or (!ref($more->[0]) and $self->dispatch_object |
143 | and $self->dispatch_object->can($more->[0]))) |
144 | ) { |
79dda56f |
145 | $self->_construct_node(match => $try, run => shift(@$more)); |
481da1e2 |
146 | } elsif ( |
147 | (blessed($try) && $try->isa('Web::Dispatch::Matcher')) |
148 | and (ref($more->[0]) eq 'CODE') |
149 | ) { |
79dda56f |
150 | $self->_construct_node(match => $try, run => shift(@$more)); |
4ed4fb42 |
151 | } elsif (blessed($try) && $try->can('to_app')) { |
152 | $try->to_app; |
153 | } else { |
154 | die "No idea how we got here with $try"; |
155 | } |
156 | } |
157 | |
158 | sub _construct_node { |
159 | my ($self, %args) = @_; |
79dda56f |
160 | $args{match} = $self->_parser->parse($args{match}) if !ref $args{match}; |
1f8cad5e |
161 | if ( my $obj = $self->dispatch_object) { |
162 | # if possible, call dispatchers as methods of the app object |
163 | my $dispatch_sub = $args{run}; |
164 | $args{run} = sub { $obj->$dispatch_sub(@_) }; |
165 | } |
166 | $self->node_class->new(\%args)->to_app; |
4ed4fb42 |
167 | } |
168 | |
169 | 1; |