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