line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package OX::RouteBuilder::REST; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# ABSTRACT: OX::RouteBuilder which routes to an action method in a controller class based on HTTP verbs |
4
|
|
|
|
|
|
|
our $VERSION = '0.006'; # VERSION |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
3349877
|
use Moose; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
6
|
|
7
|
1
|
|
|
1
|
|
6389
|
use namespace::autoclean; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
12
|
|
8
|
1
|
|
|
1
|
|
85
|
use Try::Tiny; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
729
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
with 'OX::RouteBuilder'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub import { |
13
|
1
|
|
|
1
|
|
16
|
my $caller = caller; |
14
|
1
|
|
|
|
|
4
|
my $meta = Moose::Util::find_meta($caller); |
15
|
1
|
|
|
|
|
16
|
$meta->add_route_builder('OX::RouteBuilder::REST'); |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub compile_routes { |
19
|
6
|
|
|
6
|
0
|
26
|
my $self = shift; |
20
|
6
|
|
|
|
|
14
|
my ($app) = @_; |
21
|
|
|
|
|
|
|
|
22
|
6
|
|
|
|
|
177
|
my $spec = $self->route_spec; |
23
|
6
|
|
|
|
|
178
|
my $params = $self->params; |
24
|
6
|
|
|
|
|
45
|
my ( $defaults, $validations ) = |
25
|
|
|
|
|
|
|
$self->extract_defaults_and_validations($params); |
26
|
6
|
|
|
|
|
83
|
$defaults = { %$spec, %$defaults }; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
my $target = sub { |
29
|
6
|
|
|
6
|
|
208039
|
my ($req) = @_; |
30
|
|
|
|
|
|
|
|
31
|
6
|
|
|
|
|
23
|
my $match = $req->mapping; |
32
|
6
|
|
|
|
|
227
|
my $c = $match->{controller}; |
33
|
6
|
|
|
|
|
16
|
my $a = $match->{action}; |
34
|
|
|
|
|
|
|
|
35
|
6
|
|
|
|
|
10
|
my $err; |
36
|
6
|
|
|
|
|
46
|
my $s = try { $app->fetch($c) } catch { ($err) = split "\n"; undef }; |
|
6
|
|
|
|
|
266
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
37
|
|
|
|
|
|
|
return [ |
38
|
6
|
50
|
|
|
|
12704
|
500, [], [ "Cannot resolve $c in " . blessed($app) . ": $err" ] |
39
|
|
|
|
|
|
|
] |
40
|
|
|
|
|
|
|
unless $s; |
41
|
|
|
|
|
|
|
|
42
|
6
|
|
|
|
|
30
|
my $component = $s->get; |
43
|
6
|
|
|
|
|
12411
|
my $method = uc( $req->method ); |
44
|
6
|
|
|
|
|
131
|
my $action = $a . '_' . $method; |
45
|
|
|
|
|
|
|
|
46
|
6
|
100
|
66
|
|
|
55
|
if ( $component->can($action) ) { |
|
|
100
|
|
|
|
|
|
47
|
4
|
|
|
|
|
20
|
return $component->$action(@_); |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
elsif ($method eq 'HEAD' && $component->can($a . '_GET')) { |
50
|
1
|
|
|
|
|
4
|
$action = $a . '_GET'; |
51
|
1
|
|
|
|
|
6
|
my $res = $component->$action(@_); |
52
|
1
|
50
|
0
|
|
|
15
|
if (ref($res) eq 'ARRAY') { |
|
|
0
|
|
|
|
|
|
53
|
1
|
|
|
|
|
5
|
$res->[2]=['']; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
elsif (blessed($res) && $res->can('content')) { |
56
|
0
|
|
|
|
|
0
|
$res->content(''); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
# else don't mess with content.. |
59
|
1
|
|
|
|
|
6
|
return $res; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
else { |
62
|
1
|
|
|
|
|
14
|
return [ 501, [], |
63
|
|
|
|
|
|
|
["Controller '$c' (".blessed($component).") has no method '$action'"] ]; |
64
|
|
|
|
|
|
|
} |
65
|
6
|
|
|
|
|
43
|
}; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
return { |
68
|
6
|
|
|
|
|
153
|
path => $self->path, |
69
|
|
|
|
|
|
|
defaults => $defaults, |
70
|
|
|
|
|
|
|
target => $target, |
71
|
|
|
|
|
|
|
validations => $validations, |
72
|
|
|
|
|
|
|
}; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub parse_action_spec { |
76
|
4
|
|
|
4
|
0
|
138207
|
my $class = shift; |
77
|
4
|
|
|
|
|
9
|
my ($action_spec) = @_; |
78
|
|
|
|
|
|
|
|
79
|
4
|
50
|
|
|
|
13
|
return if ref($action_spec); |
80
|
4
|
100
|
|
|
|
21
|
return unless $action_spec =~ /^REST\.(\w+)\.(\w+)$/; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
return { |
83
|
2
|
|
|
|
|
15
|
controller => $1, |
84
|
|
|
|
|
|
|
action => $2, |
85
|
|
|
|
|
|
|
name => $action_spec, |
86
|
|
|
|
|
|
|
}; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
1; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
__END__ |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=pod |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=encoding UTF-8 |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head1 NAME |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
OX::RouteBuilder::REST - OX::RouteBuilder which routes to an action method in a controller class based on HTTP verbs |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head1 VERSION |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
version 0.006 |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=head1 SYNOPSIS |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
package MyApp; |
110
|
|
|
|
|
|
|
use OX; |
111
|
|
|
|
|
|
|
use OX::RouteBuilder::REST; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
has thing => ( |
114
|
|
|
|
|
|
|
is => 'ro', |
115
|
|
|
|
|
|
|
isa => 'MyApp::Controller::Thing', |
116
|
|
|
|
|
|
|
); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
router as { |
119
|
|
|
|
|
|
|
route '/thing' => 'REST.thing.root'; |
120
|
|
|
|
|
|
|
route '/thing/:id' => 'REST.thing.item'; |
121
|
|
|
|
|
|
|
}; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
package MyApp::Controller::Thing; |
125
|
|
|
|
|
|
|
use Moose; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub root_GET { |
128
|
|
|
|
|
|
|
my ($self, $req) = @_; |
129
|
|
|
|
|
|
|
... # return a list if things |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub root_PUT { |
133
|
|
|
|
|
|
|
my ($self, $req) = @_; |
134
|
|
|
|
|
|
|
... # create a new thing |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub item_GET { |
138
|
|
|
|
|
|
|
my ($self, $req, $id) = @_; |
139
|
|
|
|
|
|
|
... # view a thing |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub item_POST { |
143
|
|
|
|
|
|
|
my ($self, $req, $id) = @_; |
144
|
|
|
|
|
|
|
... # update a thing |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=head1 DESCRIPTION |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
This is an L<OX::RouteBuilder> which routes to an action method in a |
150
|
|
|
|
|
|
|
controller class based on HTTP verbs. It's a bit of a mixture between |
151
|
|
|
|
|
|
|
L<OX::RouteBuilder::ControllerAction> and |
152
|
|
|
|
|
|
|
L<OX::RouteBuilder::HTTPMethod>. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
To enable this RouteBuilder, you need to C<use OX::RouteBuilder::REST> |
155
|
|
|
|
|
|
|
in your main application class. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
The C<action_spec> should be a string in the form |
158
|
|
|
|
|
|
|
C<"REST.$controller.$action">, where C<$controller> is the name of a |
159
|
|
|
|
|
|
|
service which provides a controller instance. For each HTTP verb you |
160
|
|
|
|
|
|
|
want to support you will need to set up an action with the name |
161
|
|
|
|
|
|
|
C<$action_$verb> (e.g. C<$action_GET>, C<$action_PUT>, etc). If no |
162
|
|
|
|
|
|
|
matching action-verb-method is found, a 501 error will be returned. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
C<controller> and C<action> will also be automatically added as |
165
|
|
|
|
|
|
|
defaults for the route, as well as C<name> (which will be set to |
166
|
|
|
|
|
|
|
C<"REST.$controller.$action">). |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
A C<HEAD> request will be redirect to C<GET> (with a potential |
169
|
|
|
|
|
|
|
response body removed), unless you implement a method named |
170
|
|
|
|
|
|
|
C<$action_HEAD>. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
To generate a link to an action, use C<uri_for> with either the name |
173
|
|
|
|
|
|
|
(eg C<"REST.$controller.$action">), or by passing a HashRef C<<{ |
174
|
|
|
|
|
|
|
controller => $controller, action => $action }>>. See F<t/test.t> |
175
|
|
|
|
|
|
|
for some examples. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=for Pod::Coverage import |
178
|
|
|
|
|
|
|
compile_routes |
179
|
|
|
|
|
|
|
parse_action_spec |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head1 AUTHORS |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=over 4 |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=item * |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
Thomas Klausner <domm@plix.at> |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=item * |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Validad GmbH http://validad.com |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=back |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
This software is copyright (c) 2014 - 2023 by Thomas Klausner. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
200
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=cut |