| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
#!perl |
|
2
|
|
|
|
|
|
|
#PODNAME: Raisin::Routes::Endpoint |
|
3
|
|
|
|
|
|
|
#ABSTRACT: Endpoint class for Raisin::Routes. |
|
4
|
|
|
|
|
|
|
|
|
5
|
14
|
|
|
14
|
|
424
|
use strict; |
|
|
14
|
|
|
|
|
22
|
|
|
|
14
|
|
|
|
|
356
|
|
|
6
|
14
|
|
|
14
|
|
58
|
use warnings; |
|
|
14
|
|
|
|
|
25
|
|
|
|
14
|
|
|
|
|
744
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package Raisin::Routes::Endpoint; |
|
9
|
|
|
|
|
|
|
$Raisin::Routes::Endpoint::VERSION = '0.94'; |
|
10
|
14
|
|
|
|
|
108
|
use Plack::Util::Accessor qw( |
|
11
|
|
|
|
|
|
|
check |
|
12
|
|
|
|
|
|
|
code |
|
13
|
|
|
|
|
|
|
desc |
|
14
|
|
|
|
|
|
|
entity |
|
15
|
|
|
|
|
|
|
method |
|
16
|
|
|
|
|
|
|
named |
|
17
|
|
|
|
|
|
|
params |
|
18
|
|
|
|
|
|
|
path |
|
19
|
|
|
|
|
|
|
regex |
|
20
|
|
|
|
|
|
|
summary |
|
21
|
|
|
|
|
|
|
produces |
|
22
|
14
|
|
|
14
|
|
92
|
); |
|
|
14
|
|
|
|
|
19
|
|
|
23
|
|
|
|
|
|
|
|
|
24
|
14
|
|
|
14
|
|
1725
|
use Raisin::Util; |
|
|
14
|
|
|
|
|
26
|
|
|
|
14
|
|
|
|
|
6953
|
|
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub new { |
|
27
|
83
|
|
|
83
|
0
|
43540
|
my ($class, %args) = @_; |
|
28
|
|
|
|
|
|
|
|
|
29
|
83
|
|
|
|
|
167
|
my $self = bless {}, $class; |
|
30
|
|
|
|
|
|
|
|
|
31
|
83
|
|
|
|
|
293
|
$self->check({}); |
|
32
|
83
|
|
|
|
|
569
|
$self->params([]); |
|
33
|
|
|
|
|
|
|
|
|
34
|
83
|
|
|
|
|
716
|
@$self{ keys %args } = values %args; |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# Populate params index |
|
37
|
83
|
|
|
|
|
152
|
for my $p (@{ $self->params }) { |
|
|
83
|
|
|
|
|
186
|
|
|
38
|
59
|
50
|
66
|
|
|
277
|
if ($p->named && (my $re = $p->regex)) { |
|
39
|
0
|
|
|
|
|
0
|
$self->{check}{ $p->name } = $re; |
|
40
|
|
|
|
|
|
|
} |
|
41
|
|
|
|
|
|
|
} |
|
42
|
|
|
|
|
|
|
|
|
43
|
83
|
|
|
|
|
452
|
$self->regex($self->_build_regex); |
|
44
|
83
|
|
|
|
|
519
|
$self; |
|
45
|
|
|
|
|
|
|
} |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub _build_regex { |
|
48
|
83
|
|
|
83
|
|
109
|
my $self = shift; |
|
49
|
83
|
50
|
|
|
|
173
|
return $self->path if ref($self->path) eq 'Regexp'; |
|
50
|
|
|
|
|
|
|
|
|
51
|
83
|
|
|
|
|
380
|
my $regex = $self->path; |
|
52
|
|
|
|
|
|
|
|
|
53
|
83
|
|
|
|
|
600
|
$regex =~ s/(.?)([:*?])(\w+)/$self->_rep_regex($1, $2, $3)/eg; |
|
|
50
|
|
|
|
|
131
|
|
|
54
|
83
|
|
|
|
|
168
|
$regex =~ s/[{}]//g; |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# Allows any extensions |
|
57
|
83
|
|
|
|
|
129
|
$regex .= "(?:\\\.[^.]+?)?"; |
|
58
|
|
|
|
|
|
|
|
|
59
|
83
|
|
|
|
|
1548
|
qr/^$regex$/; |
|
60
|
|
|
|
|
|
|
} |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub _rep_regex { |
|
63
|
50
|
|
|
50
|
|
224
|
my ($self, $char, $switch, $token) = @_; |
|
64
|
|
|
|
|
|
|
|
|
65
|
50
|
|
|
|
|
138
|
my ($a, $b, $r) = ("(?<$token>", ')', undef); |
|
66
|
|
|
|
|
|
|
|
|
67
|
50
|
|
|
|
|
87
|
for ($switch) { |
|
68
|
50
|
50
|
33
|
|
|
122
|
if ($_ eq ':' || $_ eq '?') { |
|
69
|
50
|
|
50
|
|
|
99
|
$r = $a . ($self->check->{$token} // '[^/]+?') . $b; |
|
70
|
|
|
|
|
|
|
} |
|
71
|
50
|
50
|
|
|
|
369
|
if ($_ eq '*') { |
|
72
|
0
|
|
|
|
|
0
|
$r = $a . '.+' . $b; |
|
73
|
|
|
|
|
|
|
} |
|
74
|
|
|
|
|
|
|
} |
|
75
|
|
|
|
|
|
|
|
|
76
|
50
|
50
|
33
|
|
|
153
|
$char = $char . '?' if $char eq '/' && $switch eq '?'; |
|
77
|
50
|
50
|
|
|
|
100
|
$r .= '?' if $switch eq '?'; |
|
78
|
|
|
|
|
|
|
|
|
79
|
50
|
|
|
|
|
162
|
return $char . $r; |
|
80
|
|
|
|
|
|
|
} |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub tags { |
|
83
|
20
|
|
|
20
|
0
|
232
|
my $self = shift; |
|
84
|
|
|
|
|
|
|
|
|
85
|
20
|
100
|
|
|
|
36
|
unless ($self->{tags}) { |
|
86
|
17
|
|
|
|
|
29
|
return [Raisin::Util::make_tag_from_path($self->path)]; |
|
87
|
|
|
|
|
|
|
} |
|
88
|
|
|
|
|
|
|
|
|
89
|
3
|
|
|
|
|
26
|
$self->{tags}; |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub match { |
|
93
|
467
|
|
|
467
|
0
|
18058
|
my ($self, $method, $path) = @_; |
|
94
|
|
|
|
|
|
|
|
|
95
|
467
|
|
|
|
|
615
|
$self->{named} = undef; |
|
96
|
|
|
|
|
|
|
|
|
97
|
467
|
100
|
66
|
|
|
1027
|
return if !$method || lc($method) ne lc($self->method); |
|
98
|
146
|
100
|
|
|
|
793
|
return if $path !~ $self->regex; |
|
99
|
|
|
|
|
|
|
|
|
100
|
13
|
|
|
13
|
|
5136
|
my %captured = %+; |
|
|
13
|
|
|
|
|
4415
|
|
|
|
13
|
|
|
|
|
1344
|
|
|
|
76
|
|
|
|
|
1098
|
|
|
101
|
|
|
|
|
|
|
|
|
102
|
76
|
|
|
|
|
144
|
foreach my $p (@{ $self->params }) { |
|
|
76
|
|
|
|
|
179
|
|
|
103
|
96
|
100
|
|
|
|
393
|
next unless $p->named; |
|
104
|
24
|
|
|
|
|
114
|
my $copy = $captured{ $p->name }; |
|
105
|
24
|
100
|
|
|
|
130
|
return unless $p->validate(\$copy, 'quite'); |
|
106
|
|
|
|
|
|
|
} |
|
107
|
|
|
|
|
|
|
|
|
108
|
75
|
|
|
|
|
387
|
$self->named(\%captured); |
|
109
|
|
|
|
|
|
|
|
|
110
|
75
|
|
|
|
|
480
|
1; |
|
111
|
|
|
|
|
|
|
} |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
1; |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
__END__ |