File Coverage

blib/lib/Amon2/Web/Dispatcher/RouterBoom.pm
Criterion Covered Total %
statement 59 65 90.7
branch 16 24 66.6
condition n/a
subroutine 11 11 100.0
pod n/a
total 86 100 86.0


line stmt bran cond sub pod time code
1             use strict;
2 2     9   1597 use warnings;
  2         9  
  2         56  
3 2     2   12 use utf8;
  2         5  
  2         44  
4 2     2   11 use 5.008_001;
  2         4  
  2         54  
5 2     2   73 use Router::Boom::Method;
  2         6  
6 2     2   967  
  2         10066  
  2         146  
7             my $class = shift;
8             my %args = @_;
9 2     2   23 my $caller = caller(0);
10 2         6  
11 2         4 my $router = Router::Boom::Method->new();
12              
13 2         9 my $base;
14              
15 2         15 no strict 'refs';
16              
17 2     2   14 *{"${caller}::base"} = sub { $base = $_[0] };
  2         3  
  2         1139  
18              
19 2     1   8 # functions
  2         13  
  1         3  
20             #
21             # get( '/path', 'Controller#action')
22             # post('/path', 'Controller#action')
23             # put('/path', 'Controller#action')
24             # delete_('/path', 'Controller#action')
25             # any( '/path', 'Controller#action')
26             # get( '/path', sub { })
27             # post('/path', sub { })
28             # put('/path', sub { })
29             # delete_('/path', sub { })
30             # any( '/path', sub { })
31             for my $method (qw(get post put delete_ any)) {
32             *{"${caller}::${method}"} = sub {
33 2         6 my ($path, $dest) = @_;
34 10         50  
35 14     14   30 my %dest;
36             if (ref $dest eq 'CODE') {
37 14         22 $dest{code} = $dest;
38 14 100       33 } else {
39 7         10 my ($controller, $method) = split('#', $dest);
40             $dest{class} = $base ? "${base}::${controller}" : $controller;
41 7         20 $dest{method} = $method if defined $method;
42 7 50       25 }
43 7 50       19  
44             my $http_method;
45             if ($method eq 'get') {
46 14         22 $http_method = ['GET','HEAD'];
47 14 100       39 } elsif ($method eq 'post') {
    100          
    100          
    50          
48 8         17 $http_method = 'POST';
49             } elsif ($method eq 'put') {
50 2         6 $http_method = 'PUT';
51             } elsif ($method eq 'delete_') {
52 2         5 $http_method = 'DELETE';
53             }
54 2         5  
55             $router->add($http_method, $path, \%dest);
56             };
57 14         41 }
58 10         30  
59             # class methods
60             *{"${caller}::router"} = sub { $router };
61              
62 2     17   7 *{"${caller}::dispatch"} = sub {
  2         10  
  17         747  
63             my ($class, $c) = @_;
64 2         5140  
65 15     15   117 my $env = $c->request->env;
66             if (my ($dest, $captured, $method_not_allowed) = $class->router->match($env->{REQUEST_METHOD}, $env->{PATH_INFO})) {
67 15         48 if ($method_not_allowed) {
68 15 50       74 return $c->res_405();
69 15 50       5231 }
70 0         0  
71             my $res = eval {
72             if ($dest->{code}) {
73 15         26 return $dest->{code}->($c, $captured);
74 15 100       47 } else {
75 8         34 my $method = $dest->{method};
76             $c->{args} = $captured;
77 7         17 return $dest->{class}->$method($c, $captured);
78 7         13 }
79 7         67 };
80             if ($@) {
81             if ($class->can('handle_exception')) {
82 15 50       765 return $class->handle_exception($c, $@);
83 0 0       0 } else {
84 0         0 print STDERR "$env->{REQUEST_METHOD} $env->{PATH_INFO} [$env->{HTTP_USER_AGENT}]: $@";
85             return $c->res_500();
86 0         0 }
87 0         0 }
88             return $res;
89             } else {
90 15         69 return $c->res_404();
91             }
92 0           };
93             }
94 2         8  
95             1;
96              
97             =head1 NAME
98              
99             Amon2::Web::Dispatcher::RouterBoom - Router::Boom bindings
100              
101             =head1 SYNOPSIS
102              
103             package MyApp2::Web::Dispatcher;
104             use Amon2::Web::Dispatcher::RouterBoom;
105              
106             use MyApp::Web::C::Foo;
107              
108             base 'MyApp::Web::C';
109              
110             get '/' => 'Foo#bar';
111              
112             1;
113              
114             =head1 DESCRIPTION
115              
116             This is a router class for Amon2. It's based on Router::Boom.
117              
118             =head1 DSL FUNCTIONS
119              
120             =over 4
121              
122             =item C<< get($path:Str, $destnation:Str) >>
123              
124             =item C<< post($path:Str, $destnation:Str) >>
125              
126             =item C<< put($path:Str, $destnation:Str) >>
127              
128             =item C<< delete_($path:Str, $destnation:Str) >>
129              
130             =item C<< any($path:Str, $destnation:Str) >>
131              
132             get '/' => 'Root#index';
133             get '/:user' => 'User#show';
134             any '/:user/update' => 'User#update';
135             post '/:user/blog/post' => 'Blog#post';
136             put '/:user/blog/put' => 'Blog#put';
137             delete_ '/:user/blog/:id' => 'Blog#remove';
138              
139             Add routes by DSL. First argument is the path pattern in Path::Boom rules.
140             Second argument is the destination method path.
141              
142             Destination method pass is C<${class}#${method}> form.
143              
144             The path declared with get() accepts GET and HEAD.
145             The path declared with post() accepts POST method.
146             The path declared with put() accepts PUT method.
147             The path declared with delete_() accepts DELETE method.
148             The path declared with any() accepts any methods.
149              
150             =item C<< base($klass:Str) >>
151              
152             base 'My::App::Web::C';
153              
154             You can specify the base class name for 'Root#index' style definition.
155              
156             If you are write your dispatcher in following code, then the method for '/' is C<< My::App::Web::C::Root->index >>.
157              
158             base 'My::App::Web::C';
159             get '/' => 'Root#index';
160              
161             =item C<< get($path:Str, $destnation:CodeRef) >>
162              
163             =item C<< post($path:Str, $destnation:CodeRef) >>
164              
165             =item C<< put($path:Str, $destnation:CodeRef) >>
166              
167             =item C<< delete_($path:Str, $destnation:CodeRef) >>
168              
169             =item C<< any($path:Str, $destnation:CodeRef) >>
170              
171             get '/' => sub {
172             my ($c) = @_;
173             ...
174             };
175             get '/:user' => sub {
176             my ($c, $args) = @_;
177             $c->render(
178             'user.tx' => {
179             user => $args->{user},
180             },
181             );
182             };
183              
184             Add routes by DSL. First argument is the path pattern in Path::Boom rules.
185             Second argument is the destination code.
186              
187             Callback function's first argument is the context object. Second is the captured values from the router.
188              
189             =back
190              
191             =head1 ROUTING RULES
192              
193             Router::Boom's routing rule is really flexible. You can embed regexp in your rule.
194              
195             =over 4
196              
197             =item C<< /foo/bar >>
198              
199             String literal matches strings.
200              
201             =item C<< /:foo >>
202              
203             C<< :foo >> matches C<< qr{[^/]} >>. It's captured.
204              
205             =item C<< /{foo} >>
206              
207             C<< {foo} >> is same as C<< :foo >>.
208              
209             =item C<< /{foo:.*} >>
210              
211             You can use the custom regexp for capturing.
212              
213             =item C<< /* >>
214              
215             C<< * >> is same as C<< {*:.*} >>.
216              
217             =back
218              
219             =head1 EXCEPTION HANDLER
220              
221             You can customize the exception handler. You can define the special named method 'handle_exception'.
222              
223             package MyApp::Web::Dispatcher;
224              
225             sub handle_exception {
226             my ($class, $c, $e) = @_;
227              
228             if (UNIVERSAL::isa($e, 'My::Exception::Validation')) {
229             return $c->create_simple_status_page(400, 'Bad Request');
230             } else {
231             return $c->res_500();
232             }
233             }
234              
235             =head1 SEE ALSO
236              
237             L<Amon2>
238