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 actions 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 B<WARNING>: This module is still experimental. It works well, but the APIs may
 242 change without warning.
 243
 244 This module provides a sugar layer that allows controllers to declare chained
 245 RESTful actions.
 246
 247 Under the hood, all the sugar declarations are turned into Chained subs. All
 248 chain end points are declared using one of C<get>, C<get_html>, C<post>,
 249 C<put>, or C<del>. These will declare actions using the
 250 L<Catalyst::Action::REST::ForBrowsers> action class from the
 251 L<Catalyst::Action::REST> distribution.
 252
 253 =head1 PUTTING IT ALL TOGETHER
 254
 255 This module is merely sugar over Catalyst's built-in L<Chained
 256 dispatching|Catalyst::DispatchType::Chained> and L<Catalyst::Action::REST>. It
 257 helps to know how those two things work.
 258
 259 =head1 SUGAR FUNCTIONS
 260
 261 All of these functions will be exported into your controller class when you
 262 use C<CatalystX::Routes>.
 263
 264 =head2 get ...
 265
 266 This declares a C<GET> handler.
 267
 268 =head2 get_html
 269
 270 This declares a C<GET> handler for browsers. Use this to generate a standard
 271 HTML page for browsers while still being able to generate some sort of RESTful
 272 data response for other clients.
 273
 274 If a browser makes a C<GET> request and no C<get_html> action has been
 275 declared, a C<get> action is used as a fallback. See
 276 C<Catalyst::TraitFor::Request::REST::ForBrowsers> for details on how
 277 "browser-ness" is determined.
 278
 279 =head2 post ...
 280
 281 This declares a C<POST> handler.
 282
 283 =head2 put
 284
 285 This declares a C<PUT> handler.
 286
 287 =head2 del
 288
 289 This declares a C<DELETE> handler.
 290
 291 =head2 chain_point
 292
 293 This declares an intermediate chain point that should not be exposed as a
 294 public URI.
 295
 296 =head2 chained $path
 297
 298 This function takes a single argument, the previous chain point from which the
 299 action is chained.
 300
 301 =head2 args $number
 302
 303 This declares the number of arguments that this action expects. This should
 304 only be used for the end of a chain.
 305
 306 =head2 capture_args $number
 307
 308 The number of arguments to capture at this point in the chain. This should
 309 only be used for the beginning or middle parts of a chain.
 310
 311 =head2 path_part $path
 312
 313 The path part for this part of the chain. If you are declaring a chain end
 314 point with C<get>, etc., then this isn't necessary. By default, the name
 315 passed to the initial sugar function will be converted to a path part. See
 316 below for details.
 317
 318 =head2 action_class_name $class
 319
 320 Use this to declare an action class. By default, this will be
 321 L<Catalyst::Action::REST::ForBrowsers> for end points. For other parts of a
 322 chain, it simply won't be set.
 323
 324 =head1 PATH GENERATION
 325
 326 All of the end point function (C<get>, C<post>, etc.) take a path as the first
 327 argument. By default, this will be used as the C<path_part> for the chain. You
 328 can override this by explicitly calling C<path_part>, in which case the name
 329 is essentially ignored (but still required).
 330
 331 Note that it is legitimate to pass the empty string as the name for a chain's
 332 end point.
 333
 334 If the end point's name does not start with a slash, it will be prefixed with
 335 the controller's namespace.
 336
 337 If you don't specify a C<chained> value for an end point, then it will use the
 338 root URI, C</>, as the root of the chain.
 339
 340 By default, no arguments are specified for a chain's end point, meaning it
 341 will accept any number of arguments.
 342
 343 =head1 CAVEATS
 344
 345 When adding subroutines for end points to your controller, a name is generated
 346 for each subroutine based on the chained path to the subroutine. Some
 347 template-based views will automatically pick a template based on the
 348 subroutine's name if you don't specify one explicitly. This won't work very
 349 well with the bizarro names that this module generates, so you are strongly
 350 encouraged to specify a template name explicitly.
 351
 352 =head1 BUGS
 353
 354 Please report any bugs or feature requests to
 355 C<bug-catalystx-routes@rt.cpan.org>, or through the web interface at
 356 L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be
 357 notified of progress on your bug as I make changes.
 358
 359 =cut