line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!perl |
2
|
|
|
|
|
|
|
#PODNAME: Raisin::Routes |
3
|
|
|
|
|
|
|
#ABSTRACT: A routing class for Raisin. |
4
|
|
|
|
|
|
|
|
5
|
13
|
|
|
13
|
|
118852
|
use strict; |
|
13
|
|
|
|
|
26
|
|
|
13
|
|
|
|
|
356
|
|
6
|
13
|
|
|
13
|
|
56
|
use warnings; |
|
13
|
|
|
|
|
22
|
|
|
13
|
|
|
|
|
534
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package Raisin::Routes; |
9
|
|
|
|
|
|
|
$Raisin::Routes::VERSION = '0.94'; |
10
|
13
|
|
|
13
|
|
86
|
use Carp; |
|
13
|
|
|
|
|
56
|
|
|
13
|
|
|
|
|
813
|
|
11
|
13
|
|
|
|
|
132
|
use Plack::Util::Accessor qw( |
12
|
|
|
|
|
|
|
cache |
13
|
|
|
|
|
|
|
list |
14
|
|
|
|
|
|
|
routes |
15
|
13
|
|
|
13
|
|
413
|
); |
|
13
|
|
|
|
|
224
|
|
16
|
|
|
|
|
|
|
|
17
|
13
|
|
|
13
|
|
5264
|
use Raisin::Param; |
|
13
|
|
|
|
|
30
|
|
|
13
|
|
|
|
|
374
|
|
18
|
13
|
|
|
13
|
|
4560
|
use Raisin::Routes::Endpoint; |
|
13
|
|
|
|
|
32
|
|
|
13
|
|
|
|
|
346
|
|
19
|
13
|
|
|
13
|
|
72
|
use Raisin::Util; |
|
13
|
|
|
|
|
21
|
|
|
13
|
|
|
|
|
6233
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new { |
22
|
33
|
|
|
33
|
0
|
53928
|
my $class = shift; |
23
|
33
|
|
|
|
|
496
|
my $self = bless { id => rand() }, $class; |
24
|
|
|
|
|
|
|
|
25
|
33
|
|
|
|
|
155
|
$self->cache({}); |
26
|
33
|
|
|
|
|
277
|
$self->list({}); |
27
|
33
|
|
|
|
|
192
|
$self->routes([]); |
28
|
|
|
|
|
|
|
|
29
|
33
|
|
|
|
|
248
|
$self; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub add { |
33
|
64
|
|
|
64
|
1
|
12484
|
my ($self, %params) = @_; |
34
|
|
|
|
|
|
|
|
35
|
64
|
|
|
|
|
155
|
my $method = uc $params{method}; |
36
|
64
|
|
|
|
|
90
|
my $path = $params{path}; |
37
|
|
|
|
|
|
|
|
38
|
64
|
50
|
33
|
|
|
245
|
if (!$method || !$path) { |
39
|
0
|
|
|
|
|
0
|
carp "Method and path are required"; |
40
|
0
|
|
|
|
|
0
|
return; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
64
|
|
|
|
|
124
|
my $code = $params{code}; |
44
|
|
|
|
|
|
|
# Supports only CODE as route destination |
45
|
64
|
50
|
33
|
|
|
232
|
if (!$code || !(ref($code) eq 'CODE')) { |
46
|
0
|
|
|
|
|
0
|
carp "Invalid route params for $method $path"; |
47
|
0
|
|
|
|
|
0
|
return; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
64
|
|
|
|
|
89
|
my @pp; |
51
|
64
|
|
|
|
|
105
|
for my $key (qw(params named)) { |
52
|
128
|
|
100
|
|
|
438
|
my $next_param = Raisin::Util::iterate_params($params{$key} || []); |
53
|
128
|
|
|
|
|
242
|
while (my ($type, $spec) = $next_param->()) { |
54
|
179
|
100
|
|
|
|
516
|
last unless $type; |
55
|
|
|
|
|
|
|
|
56
|
51
|
|
|
|
|
176
|
push @pp, Raisin::Param->new( |
57
|
|
|
|
|
|
|
named => $key eq 'named', |
58
|
|
|
|
|
|
|
type => $type, # -> requires/optional |
59
|
|
|
|
|
|
|
spec => $spec, # -> { name => ..., type => ... } |
60
|
|
|
|
|
|
|
); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
64
|
50
|
33
|
|
|
158
|
if (ref($path) && ref($path) ne 'Regexp') { |
65
|
0
|
|
|
|
|
0
|
print STDERR "Route `$path` should be SCALAR or Regexp\n"; |
66
|
0
|
|
|
|
|
0
|
return; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# Cut off the last slash from a path |
70
|
64
|
50
|
|
|
|
180
|
$path =~ s#(.+)/$#$1# if !ref($path); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
my $ep = Raisin::Routes::Endpoint->new( |
73
|
|
|
|
|
|
|
code => $code, |
74
|
|
|
|
|
|
|
method => $method, |
75
|
|
|
|
|
|
|
params => \@pp, |
76
|
|
|
|
|
|
|
path => $path, |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
desc => $params{desc}, |
79
|
|
|
|
|
|
|
entity => $params{entity}, |
80
|
|
|
|
|
|
|
summary => $params{summary}, |
81
|
|
|
|
|
|
|
tags => $params{tags}, |
82
|
|
|
|
|
|
|
produces => $params{produces}, |
83
|
64
|
|
|
|
|
332
|
); |
84
|
64
|
|
|
|
|
118
|
push @{ $self->{routes} }, $ep; |
|
64
|
|
|
|
|
149
|
|
85
|
|
|
|
|
|
|
|
86
|
64
|
100
|
|
|
|
132
|
if ($self->list->{$path}{$method}) { |
87
|
2
|
|
|
|
|
18
|
Raisin::log(warn => "route has been redefined: $method $path"); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
64
|
|
|
|
|
1240
|
$self->list->{$path}{$method} = scalar @{ $self->{routes} }; |
|
64
|
|
|
|
|
145
|
|
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub find { |
94
|
69
|
|
|
69
|
1
|
4971
|
my ($self, $method, $path) = @_; |
95
|
|
|
|
|
|
|
|
96
|
69
|
|
|
|
|
172
|
my $cache_key = lc "$method:$path"; |
97
|
|
|
|
|
|
|
my $routes |
98
|
|
|
|
|
|
|
= exists $self->cache->{$cache_key} |
99
|
69
|
100
|
|
|
|
215
|
? $self->cache->{$cache_key} |
100
|
|
|
|
|
|
|
: $self->routes; |
101
|
|
|
|
|
|
|
|
102
|
69
|
100
|
|
|
|
521
|
my @found = grep { $_->match($method, $path) } @$routes or return; |
|
450
|
|
|
|
|
1999
|
|
103
|
|
|
|
|
|
|
|
104
|
68
|
50
|
|
|
|
322
|
if (scalar @found > 1) { |
105
|
0
|
|
|
|
|
0
|
Raisin::log(warn => "more then one route has been found: $method $path"); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
68
|
|
|
|
|
161
|
$self->cache->{$cache_key} = \@found; |
109
|
68
|
|
|
|
|
346
|
$found[0]; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
1; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
__END__ |