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
|
|
148584
|
use strict; |
|
13
|
|
|
|
|
35
|
|
|
13
|
|
|
|
|
500
|
|
6
|
13
|
|
|
13
|
|
76
|
use warnings; |
|
13
|
|
|
|
|
27
|
|
|
13
|
|
|
|
|
654
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package Raisin::Routes; |
9
|
|
|
|
|
|
|
$Raisin::Routes::VERSION = '0.93'; |
10
|
13
|
|
|
13
|
|
81
|
use Carp; |
|
13
|
|
|
|
|
28
|
|
|
13
|
|
|
|
|
895
|
|
11
|
13
|
|
|
|
|
130
|
use Plack::Util::Accessor qw( |
12
|
|
|
|
|
|
|
cache |
13
|
|
|
|
|
|
|
list |
14
|
|
|
|
|
|
|
routes |
15
|
13
|
|
|
13
|
|
545
|
); |
|
13
|
|
|
|
|
292
|
|
16
|
|
|
|
|
|
|
|
17
|
13
|
|
|
13
|
|
6722
|
use Raisin::Param; |
|
13
|
|
|
|
|
34
|
|
|
13
|
|
|
|
|
415
|
|
18
|
13
|
|
|
13
|
|
5681
|
use Raisin::Routes::Endpoint; |
|
13
|
|
|
|
|
33
|
|
|
13
|
|
|
|
|
447
|
|
19
|
13
|
|
|
13
|
|
94
|
use Raisin::Util; |
|
13
|
|
|
|
|
28
|
|
|
13
|
|
|
|
|
7894
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new { |
22
|
33
|
|
|
33
|
0
|
64562
|
my $class = shift; |
23
|
33
|
|
|
|
|
519
|
my $self = bless { id => rand() }, $class; |
24
|
|
|
|
|
|
|
|
25
|
33
|
|
|
|
|
176
|
$self->cache({}); |
26
|
33
|
|
|
|
|
310
|
$self->list({}); |
27
|
33
|
|
|
|
|
213
|
$self->routes([]); |
28
|
|
|
|
|
|
|
|
29
|
33
|
|
|
|
|
251
|
$self; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub add { |
33
|
64
|
|
|
64
|
1
|
14838
|
my ($self, %params) = @_; |
34
|
|
|
|
|
|
|
|
35
|
64
|
|
|
|
|
167
|
my $method = uc $params{method}; |
36
|
64
|
|
|
|
|
104
|
my $path = $params{path}; |
37
|
|
|
|
|
|
|
|
38
|
64
|
50
|
33
|
|
|
300
|
if (!$method || !$path) { |
39
|
0
|
|
|
|
|
0
|
carp "Method and path are required"; |
40
|
0
|
|
|
|
|
0
|
return; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
64
|
|
|
|
|
108
|
my $code = $params{code}; |
44
|
|
|
|
|
|
|
# Supports only CODE as route destination |
45
|
64
|
50
|
33
|
|
|
259
|
if (!$code || !(ref($code) eq 'CODE')) { |
46
|
0
|
|
|
|
|
0
|
carp "Invalid route params for $method $path"; |
47
|
0
|
|
|
|
|
0
|
return; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
64
|
|
|
|
|
106
|
my @pp; |
51
|
64
|
|
|
|
|
124
|
for my $key (qw(params named)) { |
52
|
128
|
|
100
|
|
|
532
|
my $next_param = Raisin::Util::iterate_params($params{$key} || []); |
53
|
128
|
|
|
|
|
307
|
while (my ($type, $spec) = $next_param->()) { |
54
|
179
|
100
|
|
|
|
638
|
last unless $type; |
55
|
|
|
|
|
|
|
|
56
|
51
|
|
|
|
|
204
|
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
|
|
|
180
|
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
|
|
|
|
196
|
$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
|
|
|
|
|
407
|
); |
84
|
64
|
|
|
|
|
135
|
push @{ $self->{routes} }, $ep; |
|
64
|
|
|
|
|
170
|
|
85
|
|
|
|
|
|
|
|
86
|
64
|
100
|
|
|
|
168
|
if ($self->list->{$path}{$method}) { |
87
|
2
|
|
|
|
|
18
|
Raisin::log(warn => "route has been redefined: $method $path"); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
64
|
|
|
|
|
1261
|
$self->list->{$path}{$method} = scalar @{ $self->{routes} }; |
|
64
|
|
|
|
|
167
|
|
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub find { |
94
|
65
|
|
|
65
|
1
|
5916
|
my ($self, $method, $path) = @_; |
95
|
|
|
|
|
|
|
|
96
|
65
|
|
|
|
|
213
|
my $cache_key = lc "$method:$path"; |
97
|
|
|
|
|
|
|
my $routes |
98
|
|
|
|
|
|
|
= exists $self->cache->{$cache_key} |
99
|
65
|
100
|
|
|
|
176
|
? $self->cache->{$cache_key} |
100
|
|
|
|
|
|
|
: $self->routes; |
101
|
|
|
|
|
|
|
|
102
|
65
|
100
|
|
|
|
584
|
my @found = grep { $_->match($method, $path) } @$routes or return; |
|
446
|
|
|
|
|
2415
|
|
103
|
|
|
|
|
|
|
|
104
|
64
|
50
|
|
|
|
349
|
if (scalar @found > 1) { |
105
|
0
|
|
|
|
|
0
|
Raisin::log(warn => "more then one route has been found: $method $path"); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
64
|
|
|
|
|
165
|
$self->cache->{$cache_key} = \@found; |
109
|
64
|
|
|
|
|
386
|
$found[0]; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
1; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
__END__ |