Commit | Line | Data |
4ed4fb42 |
1 | package Web::Dispatch; |
2 | |
3 | use Sub::Quote; |
4 | use Scalar::Util qw(blessed); |
5 | use Moo; |
6 | use Web::Dispatch::Parser; |
7 | use Web::Dispatch::Node; |
8 | |
9 | with 'Web::Dispatch::ToApp'; |
10 | |
11 | has app => (is => 'ro', required => 1); |
12 | has parser_class => ( |
13 | is => 'ro', default => quote_sub q{ 'Web::Dispatch::Parser' } |
14 | ); |
15 | has node_class => ( |
16 | is => 'ro', default => quote_sub q{ 'Web::Dispatch::Node' } |
17 | ); |
18 | has node_args => (is => 'ro', default => quote_sub q{ {} }); |
19 | has _parser => (is => 'lazy'); |
20 | |
21 | sub _build__parser { |
22 | my ($self) = @_; |
23 | $self->parser_class->new; |
24 | } |
25 | |
26 | sub call { |
27 | my ($self, $env) = @_; |
28 | $self->_dispatch($env, $self->app); |
29 | } |
30 | |
31 | sub _dispatch { |
32 | my ($self, $env, @match) = @_; |
33 | while (my $try = shift @match) { |
34 | if (ref($try) eq 'HASH') { |
35 | $env = { %$env, %$try }; |
36 | next; |
37 | } elsif (ref($try) eq 'ARRAY') { |
38 | return $try; |
39 | } |
40 | my @result = $self->_to_try($try)->($env, @match); |
41 | next unless @result and defined($result[0]); |
42 | if (ref($result[0]) eq 'ARRAY') { |
43 | return $result[0]; |
44 | } elsif (blessed($result[0]) && $result[0]->can('wrap')) { |
45 | return $result[0]->wrap(sub { |
46 | $self->_dispatch($_[0], @match) |
47 | })->($env); |
48 | } elsif (blessed($result[0]) && !$result[0]->can('to_app')) { |
49 | return $result[0]; |
50 | } else { |
51 | # make a copy so we don't screw with it assigning further up |
52 | my $env = $env; |
53 | # try not to end up quite so bloody deep in the call stack |
54 | if (@match) { |
55 | unshift @match, sub { $self->_dispatch($env, @result) }; |
56 | } else { |
57 | @match = @result; |
58 | } |
59 | } |
60 | } |
61 | return; |
62 | } |
63 | |
64 | sub _to_try { |
65 | my ($self, $try) = @_; |
66 | if (ref($try) eq 'CODE') { |
67 | if (defined(my $proto = prototype($try))) { |
68 | $self->_construct_node( |
69 | match => $self->_parser->parse($proto), run => $try |
70 | )->to_app; |
71 | } else { |
72 | $try |
73 | } |
74 | } elsif (blessed($try) && $try->can('to_app')) { |
75 | $try->to_app; |
76 | } else { |
77 | die "No idea how we got here with $try"; |
78 | } |
79 | } |
80 | |
81 | sub _construct_node { |
82 | my ($self, %args) = @_; |
83 | @args{keys %$_} = values %$_ for $self->node_args; |
84 | $self->node_class->new(\%args); |
85 | } |
86 | |
87 | 1; |