Handle a controller where the namespace is the empty string nicely.
[catagits/CatalystX-Routes.git] / lib / CatalystX / Routes.pm
1 package CatalystX::Routes;
2
3 use strict;
4 use warnings;
5
6 use CatalystX::Routes::Role::Class;
7 use CatalystX::Routes::Role::Controller;
8 use Moose::Util qw( apply_all_roles );
9 use Params::Util qw( _CODELIKE _REGEX _STRING );
10 use Scalar::Util qw( blessed );
11
12 use Moose::Exporter;
13
14 Moose::Exporter->setup_import_methods(
15     with_meta       => [qw( get get_html post put del chain_point )],
16     as_is           => [qw( chained args capture_args path_part action_class_name )],
17     class_metaroles => {
18         class => ['CatalystX::Routes::Role::Class'],
19     },
20 );
21
22 sub get {
23     _add_route( 'GET', @_ );
24 }
25
26 sub get_html {
27     _add_route( 'GET_html', @_ );
28 }
29
30 sub post {
31     _add_route( 'POST', @_ );
32 }
33
34 sub put {
35     _add_route( 'PUT', @_ );
36 }
37
38 sub del {
39     _add_route( 'DELETE', @_ );
40 }
41
42 sub _add_route {
43     my $rest = shift;
44     my $meta = shift;
45     my ( $attrs, $sub ) = _process_args( $meta, @_ );
46
47     unless ( exists $attrs->{Chained} ) {
48         $attrs->{Chained} = q{/};
49     }
50
51     my $name = $_[0];
52     $name =~ s{^/}{};
53
54     # We need to turn the full chain name into a path, since two end points
55     # from two different chains could have the same end point name.
56     $name = ( $attrs->{Chained} eq '/' ? q{} : $attrs->{Chained} ) . q{/}
57         . $name;
58
59     $name =~ s{/}{|}g;
60
61     my $meth_base = '__route__' . $name;
62
63     _maybe_add_rest_route( $meta, $meth_base, $attrs );
64
65     my $meth_name = $meth_base . q{_} . $rest;
66
67     $meta->add_method( $meth_name => sub { goto &$sub } );
68
69     return;
70 }
71
72 sub chain_point {
73     my $meta = shift;
74     my $name = shift;
75     _add_chain_point( $meta, $name, chain_point => 1, @_ );
76 }
77
78 sub _add_chain_point {
79     my $meta = shift;
80     my ( $attrs, $sub ) = _process_args( $meta, @_ );
81
82     my $name = $_[0];
83     $name =~ s{/}{|}g;
84
85     $meta->add_chain_point( $name => [ $attrs, $sub ] );
86 }
87
88 sub _process_args {
89     my $meta = shift;
90     my $path = shift;
91     my $sub  = pop;
92
93     my $caller = ( caller(2) )[3];
94
95     die
96         "The $caller keyword expects a path string or regex as its first argument"
97         unless _STRINGLIKE0($path) || _REGEX($path);
98
99     die "The $caller keyword expects a sub ref as its final argument"
100         unless _CODELIKE($sub);
101
102     my %p = @_;
103
104     unless ( delete $p{chain_point} ) {
105         $p{ActionClass} ||= 'REST::ForBrowsers';
106     }
107
108     unless ( $p{PathPart} ) {
109         my $part = $path;
110
111         unless ( exists $p{Chained} ) {
112             unless ( $part =~ s{^/}{} ) {
113                 $part = join q{/},
114                     $meta->name()->action_namespace('FakeConfig'), $part;
115                 $part =~ s{^/}{};
116             }
117         }
118
119         $p{PathPart} = [$part];
120     }
121
122     return \%p, $sub;
123 }
124
125 sub _maybe_add_rest_route {
126     my $meta  = shift;
127     my $name  = shift;
128     my $attrs = shift;
129
130     return if $meta->has_method($name);
131
132     # This could be done by Moose::Exporter, but that would require that the
133     # module has already inherited from Cat::Controller when it calls "use
134     # CatalystX::Routes".
135     unless ( $meta->does_role('CatalystX::Routes::Role::Controller') ) {
136         apply_all_roles(
137             $meta->name(),
138             'CatalystX::Routes::Role::Controller'
139         );
140     }
141
142     $meta->add_method( $name => sub { } );
143
144     $meta->add_route( $name => [ $attrs, $meta->get_method($name) ] );
145
146     return;
147 }
148
149 sub chained ($) {
150     return ( Chained => $_[0] );
151 }
152
153 sub args ($) {
154     return ( Args => [ $_[0] ] );
155 }
156
157 sub capture_args ($) {
158     return ( CaptureArgs => [ $_[0] ] );
159 }
160
161 sub path_part ($) {
162     return ( PathPart => [ $_[0] ] );
163 }
164
165 sub action_class_name ($) {
166     return ( ActionClass => [ $_[0] ] );
167 }
168
169 # XXX - this should be added to Params::Util
170 sub _STRINGLIKE0 ($) {
171     return _STRING( $_[0] )
172         || ( defined $_[0]
173         && $_[0] eq q{} )
174         || ( blessed $_[0]
175         && overload::Method( $_[0], q{""} )
176         && length "$_[0]" );
177 }
178
179 {
180
181     # This is a nasty hack around some weird back compat code in
182     # Catalyst::Controller->action_namespace
183     package FakeConfig;
184
185     sub config {
186         return { case_sensitive => 0 };
187     }
188 }
189
190 1;
191
192 # ABSTRACT: Sugar for declaring RESTful chained action in Catalyst
193
194 __END__
195
196 =head1 SYNOPSIS
197
198   package MyApp::Controller::User;
199
200   use Moose;
201   use CatalystX::Routes;
202
203   BEGIN { extends 'Catalyst::Controller'; }
204
205   # /user/:user_id
206
207   chain_point '_set_user'
208       => chained '/'
209       => path_part 'user'
210       => capture_args 1
211       => sub {
212           my $self = shift;
213           my $c    = shift;
214           my $user_id = shift;
215
216           $c->stash()->{user} = ...;
217       };
218
219   # GET /user/:user_Id
220   get ''
221      => chained('_set_user')
222      => args 0
223      => sub { ... };
224
225   # GET /user/foo
226   get 'foo' => sub { ... };
227
228   sub _post { ... }
229
230   # POST /user/foo
231   post 'foo' => \&_post;
232
233   # PUT /root
234   put '/root' => sub { ... };
235
236   # /user/plain_old_catalyst
237   sub plain_old_catalyst : Local { ... }
238
239 =head1 DESCRIPTION
240
241 This module provides a sugar layer that allows controllers to declare chained
242 RESTful actions.
243
244 Under the hood, all the sugar declarations are turned into Chained subs. All
245 chain end points are declared using one of C<get>, C<get_html>, C<post>,
246 C<put>, or C<del>. These will declare actions using the
247 L<Catalyst::Action::REST::ForBrowsers> action class from the
248 L<Catalyst::Action::REST> distribution.
249
250 =head1 PUTTING IT ALL TOGETHER
251
252 This module is merely sugar over Catalyst's built-in L<Chained
253 dispatching|Catalyst::DispatchType::Chained> and L<Catalyst::Action::REST>. It
254 helps to know how those two things work.
255
256 =head1 SUGAR FUNCTIONS
257
258 All of these functions will be exported into your controller class when you
259 use C<CatalystX::Routes>.
260
261 =head2 get ...
262
263 This declares a C<GET> handler.
264
265 =head2 get_html
266
267 This declares a C<GET> handler for browsers. Use this to generate a standard
268 HTML page for browsers while still being able to generate some sort of RESTful
269 data response for other clients.
270
271 If a browser makes a C<GET> request and no C<get_html> action has been
272 declared, a C<get> action is used as a fallback. See
273 C<Catalyst::TraitFor::Request::REST::ForBrowsers> for details on how
274 "browser-ness" is determined.
275
276 =head2 post ...
277
278 This declares a C<POST> handler.
279
280 =head2 put
281
282 This declares a C<PUT> handler.
283
284 =head2 del
285
286 This declares a C<DELETE> handler.
287
288 =head2 chain_point
289
290 This declares an intermediate chain point that should not be exposed as a
291 public URI.
292
293 =head2 chained $path
294
295 This function takes a single argument, the previous chain point from which the
296 action is chained.
297
298 =head2 args $number
299
300 This declares the number of arguments that this action expects. This should
301 only be used for the end of a chain.
302
303 =head2 capture_args $number
304
305 The number of arguments to capture at this point in the chain. This should
306 only be used for the beginning or middle parts of a chain.
307
308 =head2 path_part $path
309
310 The path part for this part of the chain. If you are declaring a chain end
311 point with C<get>, etc., then this isn't necessary. By default, the name
312 passed to the initial sugar function will be converted to a path part. See
313 below for details.
314
315 =head2 action_class_name $class
316
317 Use this to declare an action class. By default, this will be
318 L<Catalyst::Action::REST::ForBrowsers> for end points. For other parts of a
319 chain, it simply won't be set.
320
321 =head1 PATH GENERATION
322
323 All of the end point function (C<get>, C<post>, etc.) take a path as the first
324 argument. By default, this will be used as the C<path_part> for the chain. You
325 can override this by explicitly calling C<path_part>, in which case the name
326 is essentially ignored (but still required).
327
328 Note that it is legitimate to pass the empty string as the name for a chain's
329 end point.
330
331 If the end point's name does not start with a slash, it will be prefixed with
332 the controller's namespace.
333
334 If you don't specify a C<chained> value for an end point, then it will use the
335 root URI, C</>, as the root of the chain.
336
337 By default, no arguments are specified for a chain's end point, meaning it
338 will accept any number of arguments.
339
340 =head1 CAVEATS
341
342 When adding subroutines for end points to your controller, a name is generated
343 for each subroutine based on the chained path to the subroutine. Some
344 template-based views will automatically pick a template based on the
345 subroutine's name if you don't specify one explicitly. This won't work very
346 well with the bizarro names that this module generates, so you are strongly
347 encouraged to specify a template name explicitly.
348
349 =head1 BUGS
350
351 Please report any bugs or feature requests to
352 C<bug-catalystx-routes@rt.cpan.org>, or through the web interface at
353 L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be
354 notified of progress on your bug as I make changes.
355
356 =cut