line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Dancer::Plugin::REST; |
2
|
|
|
|
|
|
|
BEGIN { |
3
|
8
|
|
|
8
|
|
2340737
|
$Dancer::Plugin::REST::AUTHORITY = 'cpan:SUKRIA'; |
4
|
|
|
|
|
|
|
} |
5
|
|
|
|
|
|
|
# ABSTRACT: A plugin for writing RESTful apps with Dancer |
6
|
|
|
|
|
|
|
$Dancer::Plugin::REST::VERSION = '0.11'; |
7
|
8
|
|
|
8
|
|
84
|
use strict; |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
271
|
|
8
|
8
|
|
|
8
|
|
43
|
use warnings; |
|
8
|
|
|
|
|
20
|
|
|
8
|
|
|
|
|
257
|
|
9
|
|
|
|
|
|
|
|
10
|
8
|
|
|
8
|
|
43
|
use Carp 'croak'; |
|
8
|
|
|
|
|
18
|
|
|
8
|
|
|
|
|
588
|
|
11
|
8
|
|
|
8
|
|
1247
|
use Dancer ':syntax'; |
|
8
|
|
|
|
|
288786
|
|
|
8
|
|
|
|
|
48
|
|
12
|
8
|
|
|
8
|
|
11019
|
use Dancer::Plugin; |
|
8
|
|
|
|
|
12304
|
|
|
8
|
|
|
|
|
7958
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
my $content_types = { |
15
|
|
|
|
|
|
|
json => 'application/json', |
16
|
|
|
|
|
|
|
yml => 'text/x-yaml', |
17
|
|
|
|
|
|
|
xml => 'application/xml', |
18
|
|
|
|
|
|
|
}; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $default_serializer; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
register prepare_serializer_for_format => sub { |
23
|
1
|
|
|
1
|
|
14
|
my $conf = plugin_setting; |
24
|
1
|
50
|
33
|
|
|
48
|
my $serializers = ( |
25
|
|
|
|
|
|
|
($conf && exists $conf->{serializers}) |
26
|
|
|
|
|
|
|
? $conf->{serializers} |
27
|
|
|
|
|
|
|
: { 'json' => 'JSON', |
28
|
|
|
|
|
|
|
'yml' => 'YAML', |
29
|
|
|
|
|
|
|
'xml' => 'XML', |
30
|
|
|
|
|
|
|
'dump' => 'Dumper', |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
hook 'before' => sub { |
35
|
|
|
|
|
|
|
# remember what was there before |
36
|
0
|
|
0
|
0
|
|
0
|
$default_serializer ||= setting 'serializer'; |
37
|
|
|
|
|
|
|
|
38
|
0
|
0
|
|
|
|
0
|
my $format = params->{'format'} or return; |
39
|
|
|
|
|
|
|
|
40
|
0
|
0
|
|
|
|
0
|
my $serializer = $serializers->{$format} |
41
|
|
|
|
|
|
|
or return halt( |
42
|
|
|
|
|
|
|
Dancer::Error->new( |
43
|
|
|
|
|
|
|
code => 404, |
44
|
|
|
|
|
|
|
title => "unsupported format requested", |
45
|
|
|
|
|
|
|
message => "unsupported format requested: " . $format |
46
|
|
|
|
|
|
|
)->render |
47
|
|
|
|
|
|
|
); |
48
|
|
|
|
|
|
|
|
49
|
0
|
|
|
|
|
0
|
set serializer => $serializer; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# check if we were supposed to deserialize the request |
52
|
0
|
|
|
|
|
0
|
Dancer::Serializer->process_request( |
53
|
|
|
|
|
|
|
Dancer::SharedData->request |
54
|
|
|
|
|
|
|
); |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
0
|
|
|
0
|
content_type $content_types->{$format} || setting('content_type'); |
57
|
1
|
|
|
|
|
14
|
}; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
hook after => sub { |
60
|
|
|
|
|
|
|
# put it back the way it was |
61
|
0
|
|
|
0
|
|
0
|
set serializer => $default_serializer; |
62
|
|
|
|
|
|
|
} |
63
|
1
|
|
|
|
|
173
|
}; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my %triggers_map = ( |
66
|
|
|
|
|
|
|
get => \&get, |
67
|
|
|
|
|
|
|
update => \&put, |
68
|
|
|
|
|
|
|
create => \&post, |
69
|
|
|
|
|
|
|
delete => \&del, |
70
|
|
|
|
|
|
|
); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
register resource => sub { |
73
|
3
|
50
|
|
3
|
|
1293
|
croak "resource invoked without arguments" unless @_; |
74
|
|
|
|
|
|
|
|
75
|
3
|
|
|
|
|
21
|
my ($resource, %triggers) = @_; |
76
|
|
|
|
|
|
|
|
77
|
3
|
|
|
|
|
17
|
while( my( $t, $sub ) = each %triggers ) { |
78
|
10
|
100
|
|
|
|
1911
|
my $method = $triggers_map{$t} |
79
|
|
|
|
|
|
|
or croak "action '$t' not recognized"; |
80
|
|
|
|
|
|
|
|
81
|
9
|
100
|
|
|
|
28
|
if ( $t eq 'create' ) { |
82
|
2
|
|
|
|
|
13
|
$method->( "/${resource}" => $triggers{$t} ); |
83
|
2
|
|
|
|
|
367
|
$method->( "/${resource}.:format" => $triggers{$t} ); |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
else { |
86
|
7
|
|
|
|
|
14
|
for my $ext ( '.:format', '' ) { |
87
|
14
|
|
|
|
|
2267
|
$method->( "/${resource}/:id$ext" => $triggers{$t} ); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
}; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
register send_entity => sub { |
95
|
|
|
|
|
|
|
# entity, status_code |
96
|
8
|
|
50
|
8
|
|
44
|
status($_[1] || 200); |
97
|
8
|
|
|
|
|
214
|
$_[0]; |
98
|
|
|
|
|
|
|
}; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
my %http_codes = ( |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# 1xx |
103
|
|
|
|
|
|
|
100 => 'Continue', |
104
|
|
|
|
|
|
|
101 => 'Switching Protocols', |
105
|
|
|
|
|
|
|
102 => 'Processing', |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# 2xx |
108
|
|
|
|
|
|
|
200 => 'OK', |
109
|
|
|
|
|
|
|
201 => 'Created', |
110
|
|
|
|
|
|
|
202 => 'Accepted', |
111
|
|
|
|
|
|
|
203 => 'Non-Authoritative Information', |
112
|
|
|
|
|
|
|
204 => 'No Content', |
113
|
|
|
|
|
|
|
205 => 'Reset Content', |
114
|
|
|
|
|
|
|
206 => 'Partial Content', |
115
|
|
|
|
|
|
|
207 => 'Multi-Status', |
116
|
|
|
|
|
|
|
210 => 'Content Different', |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# 3xx |
119
|
|
|
|
|
|
|
300 => 'Multiple Choices', |
120
|
|
|
|
|
|
|
301 => 'Moved Permanently', |
121
|
|
|
|
|
|
|
302 => 'Found', |
122
|
|
|
|
|
|
|
303 => 'See Other', |
123
|
|
|
|
|
|
|
304 => 'Not Modified', |
124
|
|
|
|
|
|
|
305 => 'Use Proxy', |
125
|
|
|
|
|
|
|
307 => 'Temporary Redirect', |
126
|
|
|
|
|
|
|
310 => 'Too many Redirect', |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# 4xx |
129
|
|
|
|
|
|
|
400 => 'Bad Request', |
130
|
|
|
|
|
|
|
401 => 'Unauthorized', |
131
|
|
|
|
|
|
|
402 => 'Payment Required', |
132
|
|
|
|
|
|
|
403 => 'Forbidden', |
133
|
|
|
|
|
|
|
404 => 'Not Found', |
134
|
|
|
|
|
|
|
405 => 'Method Not Allowed', |
135
|
|
|
|
|
|
|
406 => 'Not Acceptable', |
136
|
|
|
|
|
|
|
407 => 'Proxy Authentication Required', |
137
|
|
|
|
|
|
|
408 => 'Request Time-out', |
138
|
|
|
|
|
|
|
409 => 'Conflict', |
139
|
|
|
|
|
|
|
410 => 'Gone', |
140
|
|
|
|
|
|
|
411 => 'Length Required', |
141
|
|
|
|
|
|
|
412 => 'Precondition Failed', |
142
|
|
|
|
|
|
|
413 => 'Request Entity Too Large', |
143
|
|
|
|
|
|
|
414 => 'Request-URI Too Long', |
144
|
|
|
|
|
|
|
415 => 'Unsupported Media Type', |
145
|
|
|
|
|
|
|
416 => 'Requested range unsatisfiable', |
146
|
|
|
|
|
|
|
417 => 'Expectation failed', |
147
|
|
|
|
|
|
|
418 => 'Teapot', |
148
|
|
|
|
|
|
|
422 => 'Unprocessable entity', |
149
|
|
|
|
|
|
|
423 => 'Locked', |
150
|
|
|
|
|
|
|
424 => 'Method failure', |
151
|
|
|
|
|
|
|
425 => 'Unordered Collection', |
152
|
|
|
|
|
|
|
426 => 'Upgrade Required', |
153
|
|
|
|
|
|
|
449 => 'Retry With', |
154
|
|
|
|
|
|
|
450 => 'Parental Controls', |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# 5xx |
157
|
|
|
|
|
|
|
500 => 'Internal Server Error', |
158
|
|
|
|
|
|
|
501 => 'Not Implemented', |
159
|
|
|
|
|
|
|
502 => 'Bad Gateway', |
160
|
|
|
|
|
|
|
503 => 'Service Unavailable', |
161
|
|
|
|
|
|
|
504 => 'Gateway Time-out', |
162
|
|
|
|
|
|
|
505 => 'HTTP Version not supported', |
163
|
|
|
|
|
|
|
507 => 'Insufficient storage', |
164
|
|
|
|
|
|
|
509 => 'Bandwidth Limit Exceeded', |
165
|
|
|
|
|
|
|
); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
for my $code (keys %http_codes) { |
168
|
|
|
|
|
|
|
my $helper_name = lc($http_codes{$code}); |
169
|
|
|
|
|
|
|
$helper_name =~ s/[^\w]+/_/gms; |
170
|
|
|
|
|
|
|
$helper_name = "status_${helper_name}"; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
register $helper_name => sub { |
173
|
8
|
100
|
|
8
|
|
25663
|
if ($code >= 400) { |
174
|
3
|
|
|
|
|
15
|
send_entity({error => $_[0]}, $code); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
else { |
177
|
5
|
|
|
|
|
18
|
send_entity($_[0], $code); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
}; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
register_plugin; |
183
|
|
|
|
|
|
|
1; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
__END__ |