File Coverage

lib/Catalyst/Action/REST.pm
Criterion Covered Total %
statement 77 77 100.0
branch 13 14 92.8
condition 4 5 80.0
subroutine 16 16 100.0
pod 2 3 66.6
total 112 115 97.3


line stmt bran cond sub pod time code
1             package Catalyst::Action::REST;
2             $Catalyst::Action::REST::VERSION = '1.20';
3 6     6   228263 use utf8;
  6         14  
  6         83  
4 6     6   238 use Moose;
  6         15  
  6         49  
5 6     6   39507 use namespace::autoclean;
  6         16  
  6         66  
6              
7             extends 'Catalyst::Action';
8 6     6   5818 use Class::Inspector;
  6         17729  
  6         190  
9 6     6   1255 use Catalyst::Request::REST;
  6         18  
  6         177  
10 6     6   41 use Catalyst::Controller::REST;
  6         12  
  6         222  
11              
12 6     6   6182 BEGIN { require 5.008001; }
13              
14             sub BUILDARGS {
15 54     54 1 100 my $class = shift;
16 54         100 my $config = shift;
17 54         324 Catalyst::Request::REST->_insert_self_into( $config->{class} );
18 54         2561 return $class->SUPER::BUILDARGS($config, @_);
19             }
20              
21             =encoding utf-8
22              
23             =head1 NAME
24              
25             Catalyst::Action::REST - Automated REST Method Dispatching
26              
27             =head1 SYNOPSIS
28              
29             sub foo :Local :ActionClass('REST') {
30             ... do setup for HTTP method specific handlers ...
31             }
32              
33             sub foo_GET {
34             ... do something for GET requests ...
35             }
36              
37             # alternatively use an Action
38             sub foo_PUT : Action {
39             ... do something for PUT requests ...
40             }
41              
42             =head1 DESCRIPTION
43              
44             This Action handles doing automatic method dispatching for REST requests. It
45             takes a normal Catalyst action, and changes the dispatch to append an
46             underscore and method name. First it will try dispatching to an action with
47             the generated name, and failing that it will try to dispatch to a regular
48             method.
49              
50             For example, in the synopsis above, calling GET on "/foo" would result in
51             the foo_GET method being dispatched.
52              
53             If a method is requested that is not implemented, this action will
54             return a status 405 (Method Not Found). It will populate the "Allow" header
55             with the list of implemented request methods. You can override this behavior
56             by implementing a custom 405 handler like so:
57              
58             sub foo_not_implemented {
59             ... handle not implemented methods ...
60             }
61              
62             If you do not provide an _OPTIONS subroutine, we will automatically respond
63             with a 200 OK. The "Allow" header will be populated with the list of
64             implemented request methods. If you do not provide an _HEAD either, we will
65             auto dispatch to the _GET one in case it exists.
66              
67             It is likely that you really want to look at L<Catalyst::Controller::REST>,
68             which brings this class together with automatic Serialization of requests
69             and responses.
70              
71             When you use this module, it adds the L<Catalyst::TraitFor::Request::REST>
72             role to your request class.
73              
74             =head1 METHODS
75              
76             =over 4
77              
78             =item dispatch
79              
80             This method overrides the default dispatch mechanism to the re-dispatching
81             mechanism described above.
82              
83             =cut
84              
85             sub dispatch {
86 27     27 1 179809 my $self = shift;
87 27         72 my $c = shift;
88              
89 27         821 my $rest_method = $self->name . "_" . uc( $c->request->method );
90              
91 27         267 return $self->_dispatch_rest_method( $c, $rest_method );
92             }
93              
94             sub _dispatch_rest_method {
95 31     31   62 my $self = shift;
96 31         98 my $c = shift;
97 31         51 my $rest_method = shift;
98 31         845 my $req = $c->request;
99              
100 31         1095 my $controller = $c->component( $self->class );
101              
102 31         1310 my ($code, $name);
103              
104             # Execute normal 'foo' action.
105 31         920 $c->execute( $self->class, $self, @{ $req->args } );
  31         210  
106              
107             # Common case, for foo_GET etc
108 31 100       15274 if ( $code = $controller->action_for($rest_method) ) {
    100          
109 11         2611 return $c->forward( $code, $req->args ); # Forward to foo_GET if it's an action
110             }
111             elsif ($code = $controller->can($rest_method)) {
112 11         2377 $name = $rest_method; # Stash name and code to run 'foo_GET' like an action below.
113             }
114              
115             # Generic handling for foo_*
116 20 100       2056 if (!$code) {
117             my $code_action = {
118             OPTIONS => sub {
119 3     3   9 $name = $rest_method;
120 3         16 $code = sub { $self->_return_options($self->name, @_) };
  3         788  
121             },
122             HEAD => sub {
123 3     3   16 $rest_method =~ s{_HEAD$}{_GET}i;
124 3         19 $self->_dispatch_rest_method($c, $rest_method);
125             },
126             default => sub {
127             # Otherwise, not implemented.
128 3     3   88 $name = $self->name . "_not_implemented";
129             $code = $controller->can($name) # User method
130             # Generic not implemented
131 3   100     50 || sub { $self->_return_not_implemented($self->name, @_) };
132             },
133 9         125 };
134 9         278 my ( $http_method, $action_name ) = ( $rest_method, $self->name );
135 9         182 $http_method =~ s{\Q$action_name\E\_}{};
136             my $respond = ($code_action->{$http_method}
137 9   66     52 || $code_action->{'default'})->();
138 9 100       2722 return $respond unless $name;
139             }
140              
141             # localise stuff so we can dispatch the action 'as normal, but get
142             # different stats shown, and different code run.
143             # Also get the full path for the action, and make it look like a forward
144 17         54 local $self->{code} = $code;
145 17         555 my @name = split m{/}, $self->reverse;
146 17         143 $name[-1] = $name;
147 17         70 local $self->{reverse} = "-> " . join('/', @name);
148              
149 17         497 $c->execute( $self->class, $self, @{ $req->args } );
  17         119  
150             }
151              
152             sub get_allowed_methods {
153 5     5 0 12 my ( $self, $controller, $c, $name ) = @_;
154 5 50       34 my $class = ref($controller) ? ref($controller) : $controller;
155             my $methods = {
156 590 100       8154 map { /^$name\_(.+)$/ ? ( $1 => 1 ) : () }
157 5         7 @{ Class::Inspector->methods($class) }
  5         56  
158             };
159 5 100       49 $methods->{'HEAD'} = 1 if $methods->{'GET'};
160 5         12 delete $methods->{'not_implemented'};
161 5         46 return sort keys %$methods;
162             };
163              
164             sub _return_options {
165 3     3   24 my ( $self, $method_name, $controller, $c) = @_;
166 3         16 my @allowed = $self->get_allowed_methods($controller, $c, $method_name);
167 3         99 $c->response->content_type('text/plain');
168 3         904 $c->response->status(200);
169 3         428 $c->response->header( 'Allow' => \@allowed );
170 3         817 $c->response->body(q{});
171             }
172              
173             sub _return_not_implemented {
174 2     2   17 my ( $self, $method_name, $controller, $c ) = @_;
175              
176 2         10 my @allowed = $self->get_allowed_methods($controller, $c, $method_name);
177 2         64 $c->response->content_type('text/plain');
178 2         607 $c->response->status(405);
179 2         286 $c->response->header( 'Allow' => \@allowed );
180 2         531 $c->response->body( "Method "
181             . $c->request->method
182             . " not implemented for "
183             . $c->uri_for( $method_name ) );
184             }
185              
186             __PACKAGE__->meta->make_immutable;
187              
188             1;
189              
190             =back
191              
192             =head1 SEE ALSO
193              
194             You likely want to look at L<Catalyst::Controller::REST>, which implements a
195             sensible set of defaults for a controller doing REST.
196              
197             This class automatically adds the L<Catalyst::TraitFor::Request::REST> role to
198             your request class. If you're writing a web application which provides RESTful
199             responses and still needs to accommodate web browsers, you may prefer to use
200             L<Catalyst::TraitFor::Request::REST::ForBrowsers> instead.
201              
202             L<Catalyst::Action::Serialize>, L<Catalyst::Action::Deserialize>
203              
204             =head1 TROUBLESHOOTING
205              
206             =over 4
207              
208             =item Q: I'm getting a "415 Unsupported Media Type" error. What gives?!
209              
210             A: Most likely, you haven't set Content-type equal to "application/json", or
211             one of the accepted return formats. You can do this by setting it in your query
212             accepted return formats. You can do this by setting it in your query string
213             thusly: C<< ?content-type=application%2Fjson (where %2F == / uri escaped). >>
214              
215             B<NOTE> Apache will refuse %2F unless configured otherwise.
216             Make sure C<AllowEncodedSlashes On> is in your httpd.conf file in order
217             for this to run smoothly.
218              
219             =back
220              
221             =head1 AUTHOR
222              
223             Adam Jacob E<lt>adam@stalecoffee.orgE<gt>, with lots of help from mst and jrockway
224              
225             Marchex, Inc. paid me while I developed this module. (L<http://www.marchex.com>)
226              
227             =head1 CONTRIBUTORS
228              
229             Tomas Doran (t0m) E<lt>bobtfish@bobtfish.netE<gt>
230              
231             John Goulah
232              
233             Christopher Laco
234              
235             Daisuke Maki E<lt>daisuke@endeworks.jpE<gt>
236              
237             Hans Dieter Pearcey
238              
239             Brian Phillips E<lt>bphillips@cpan.orgE<gt>
240              
241             Dave Rolsky E<lt>autarch@urth.orgE<gt>
242              
243             Luke Saunders
244              
245             Arthur Axel "fREW" Schmidt E<lt>frioux@gmail.comE<gt>
246              
247             J. Shirley E<lt>jshirley@gmail.comE<gt>
248              
249             Gavin Henry E<lt>ghenry@surevoip.co.ukE<gt>
250              
251             Gerv http://www.gerv.net/
252              
253             Colin Newell <colin@opusvl.com>
254              
255             Wallace Reis E<lt>wreis@cpan.orgE<gt>
256              
257             André Walker (andrewalker) <andre@cpan.org>
258              
259             =head1 COPYRIGHT
260              
261             Copyright (c) 2006-2015 the above named AUTHOR and CONTRIBUTORS
262              
263             =head1 LICENSE
264              
265             You may distribute this code under the same terms as Perl itself.
266              
267             =cut
268