File Coverage

blib/lib/Amon2/Web/Dispatcher/RouterSimple/Extended.pm
Criterion Covered Total %
statement 67 72 93.0
branch 10 14 71.4
condition 6 13 46.1
subroutine 12 12 100.0
pod n/a
total 95 111 85.5


line stmt bran cond sub pod time code
1             package Amon2::Web::Dispatcher::RouterSimple::Extended;
2 2     2   437644 use strict;
  2         5  
  2         70  
3 2     2   83 use warnings;
  2         4  
  2         94  
4              
5             our $VERSION = "0.05.01";
6              
7 2     2   2059 use Router::Simple 0.03;
  2         13686  
  2         296  
8              
9             my @METHODS = qw/GET POST PUT DELETE/;
10             my $submap;
11              
12             sub import {
13 2     2   28 my $class = shift;
14 2         5 my %args = @_;
15 2         5 my $caller = caller(0);
16              
17 2         10 my $router = Router::Simple->new;
18              
19 2     2   18 no strict 'refs';
  2         3  
  2         1829  
20              
21             # functions
22 2         13 *{"${caller}::submapper"} = \&_submapper;
  2         14  
23 2         209 *{"${caller}::connect"} = \&_connect;
  2         11  
24 2         7 for my $method (@METHODS) {
25 8         18 *{"${caller}::@{[lc $method]}"} = _make_method_connector($caller, $method);
  8         13  
  8         58  
26             }
27              
28             # class methods
29 2     15   6 *{"${caller}::router"} = sub { $router };
  2         10  
  15         78  
30 2         4 for my $meth (qw/match as_string/) {
31 4         20 *{"$caller\::${meth}"} = sub {
32 7     7   43 my $class = shift;
33 7         23 $class->router->$meth(@_)
34 4         9 };
35             }
36 2         4 *{"$caller\::dispatch"} = \&_dispatch;
  2         7613  
37             }
38              
39             sub _make_method_connector {
40 8     8   13 my ($caller, $method) = @_;
41              
42             sub {
43 2     2   13 my $class = caller(0);
44              
45 2 100       6 if ($submap) {
46 1         2 my ($path, $action) = @_;
47 1         9 $submap->connect($path, { action => $action }, { metod => $method });
48             } else {
49 1         4 $_[2] = { method => $method };
50 1         6 goto \&_connect;
51             }
52             }
53 8         47 }
54              
55             sub _connect {
56 5     5   13 my $caller = caller(0);
57 5 50       13 if ($submap) {
58 0 0 0     0 if (@_ >= 2 && !ref $_[1]) {
59 0         0 my ($path, $action, $opt) = @_;
60 0   0     0 $submap->connect($path, { action => $action }, $opt || {});
61             } else {
62 0         0 $submap->connect(@_);
63             }
64             } else {
65 5         14 my $router = $caller->router;
66 5 100 66     32 if (@_ >= 2 && !ref $_[1]) {
67 3         8 my ($path, $dest_str, $opt) = @_;
68 3         11 my ($controller, $action) = split('#', $dest_str);
69 3         10 my $dest = { controller => $controller };
70 3 100       12 $dest->{action} = $action if defined $action;
71 3   100     22 $router->connect($path, $dest, $opt || {});
72             } else {
73 2         11 $router->connect(@_);
74             }
75             }
76             }
77              
78             sub _submapper {
79 2     2   125 my $caller = caller(0);
80 2         8 my $router = caller(0)->router();
81 2 100 66     14 if ($_[2] && ref($_[2]) eq 'CODE') {
82 1         4 my ($path, $controller, $callback) = @_;
83 1         9 $submap = $router->submapper($path, { controller => $controller });
84 1         36 $callback->();
85 1         71 undef $submap;
86             }
87             else {
88 1         6 $router->submapper(@_);
89             }
90             }
91              
92             sub _dispatch {
93 7     7   81021 my ($class, $c) = @_;
94 7         32 my $req = $c->request;
95 7 50       45 if (my $p = $class->match($req->env)) {
96 7         560 my $action = $p->{action};
97 7         17 $c->{args} = $p;
98 7         15 "@{[ ref Amon2->context ]}::C::$p->{controller}"->$action($c, $p);
  7         41  
99             } else {
100 0           $c->res_404();
101             }
102             }
103              
104             1;
105             __END__