lib/CatalystX/Routes.pm

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