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 | |
14 | has app => (is => 'ro', required => 1); |
15 | has parser_class => ( |
16 | is => 'ro', default => quote_sub q{ 'Web::Dispatch::Parser' } |
17 | ); |
18 | has node_class => ( |
19 | is => 'ro', default => quote_sub q{ 'Web::Dispatch::Node' } |
20 | ); |
21 | has node_args => (is => 'ro', default => quote_sub q{ {} }); |
22 | has _parser => (is => 'lazy'); |
23 | |
24 | sub _build__parser { |
25 | my ($self) = @_; |
26 | $self->parser_class->new; |
27 | } |
28 | |
29 | sub call { |
30 | my ($self, $env) = @_; |
31 | $self->_dispatch($env, $self->app); |
32 | } |
33 | |
34 | sub _dispatch { |
35 | my ($self, $env, @match) = @_; |
36 | while (my $try = shift @match) { |
75ad66d6 |
37 | |
38 | return $try if ref($try) eq 'ARRAY'; |
4ed4fb42 |
39 | if (ref($try) eq 'HASH') { |
40 | $env = { %$env, %$try }; |
41 | next; |
4ed4fb42 |
42 | } |
75ad66d6 |
43 | |
69aaa28a |
44 | my @result = $self->_to_try($try, \@match)->($env, @match); |
4ed4fb42 |
45 | next unless @result and defined($result[0]); |
75ad66d6 |
46 | |
47 | my $first = $result[0]; |
48 | |
49 | return $self->_unpack_array_match( $first ) |
50 | if ref($first) eq 'ARRAY'; |
51 | |
52 | return $self->_prepare_middleware( $first, \@result ) |
53 | if blessed($first) && $first->isa('Plack::Middleware'); |
54 | |
55 | return $self->_unwrap_middleware( $first, \@match, $env ) |
56 | if ref($first) eq 'HASH' and $first->{+MAGIC_MIDDLEWARE_KEY}; |
57 | |
58 | return $first |
59 | if blessed($first) && !$first->can('to_app'); |
60 | |
61 | # make a copy so we don't screw with it assigning further up |
62 | my $env = $env; |
63 | unshift @match, sub { $self->_dispatch($env, @result) }; |
4ed4fb42 |
64 | } |
75ad66d6 |
65 | |
4ed4fb42 |
66 | return; |
67 | } |
68 | |
75ad66d6 |
69 | sub _unpack_array_match { |
70 | my ( $self, $match ) = @_; |
71 | return $match->[0] if @{$match} == 1 and ref($match->[0]) eq 'CODE'; |
72 | return $match; |
73 | } |
74 | |
75 | sub _prepare_middleware { |
76 | my ( $self, $match, $results ) = @_; |
77 | die "Multiple results but first one is a middleware ($match)" |
78 | if @{$results} > 1; |
79 | # middleware needs to uplevel exactly once to wrap the rest of the |
80 | # level it was created for - next elsif unwraps it |
81 | return { MAGIC_MIDDLEWARE_KEY, $match }; |
82 | } |
83 | |
84 | sub _unwrap_middleware { |
85 | my ( $self, $first, $match, $env ) = @_; |
86 | |
87 | my $mw = $first->{+MAGIC_MIDDLEWARE_KEY}; |
88 | |
89 | $mw->app(sub { $self->_dispatch($_[0], @{$match}) }); |
90 | |
91 | return $mw->to_app->($env); |
92 | } |
93 | |
4ed4fb42 |
94 | sub _to_try { |
69aaa28a |
95 | my ($self, $try, $more) = @_; |
4ed4fb42 |
96 | if (ref($try) eq 'CODE') { |
97 | if (defined(my $proto = prototype($try))) { |
98 | $self->_construct_node( |
99 | match => $self->_parser->parse($proto), run => $try |
100 | )->to_app; |
101 | } else { |
102 | $try |
103 | } |
69aaa28a |
104 | } elsif (!ref($try) and ref($more->[0]) eq 'CODE') { |
105 | $self->_construct_node( |
106 | match => $self->_parser->parse($try), run => shift(@$more) |
107 | )->to_app; |
4ed4fb42 |
108 | } elsif (blessed($try) && $try->can('to_app')) { |
109 | $try->to_app; |
110 | } else { |
111 | die "No idea how we got here with $try"; |
112 | } |
113 | } |
114 | |
115 | sub _construct_node { |
116 | my ($self, %args) = @_; |
69aaa28a |
117 | $self->node_class->new({ %{$self->node_args}, %args }); |
4ed4fb42 |
118 | } |
119 | |
120 | 1; |