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             }
 116         }
 117
 118         $p{PathPart} = [$part];
 119     }
 120
 121     return \%p, $sub;
 122 }
 123
 124 sub _maybe_add_rest_route {
 125     my $meta  = shift;
 126     my $name  = shift;
 127     my $attrs = shift;
 128
 129     return if $meta->has_method($name);
 130
 131     # This could be done by Moose::Exporter, but that would require that the
 132     # module has already inherited from Cat::Controller when it calls "use
 133     # CatalystX::Routes".
 134     unless ( $meta->does_role('CatalystX::Routes::Role::Controller') ) {
 135         apply_all_roles(
 136             $meta->name(),
 137             'CatalystX::Routes::Role::Controller'
 138         );
 139     }
 140
 141     $meta->add_method( $name => sub { } );
 142
 143     $meta->add_route( $name => [ $attrs, $meta->get_method($name) ] );
 144
 145     return;
 146 }
 147
 148 sub chained ($) {
 149     return ( Chained => $_[0] );
 150 }
 151
 152 sub args ($) {
 153     return ( Args => [ $_[0] ] );
 154 }
 155
 156 sub capture_args ($) {
 157     return ( CaptureArgs => [ $_[0] ] );
 158 }
 159
 160 sub path_part ($) {
 161     return ( PathPart => [ $_[0] ] );
 162 }
 163
 164 sub action_class_name ($) {
 165     return ( ActionClass => [ $_[0] ] );
 166 }
 167
 168 # XXX - this should be added to Params::Util
 169 sub _STRINGLIKE0 ($) {
 170     return _STRING( $_[0] )
 171         || ( defined $_[0]
 172         && $_[0] eq q{} )
 173         || ( blessed $_[0]
 174         && overload::Method( $_[0], q{""} )
 175         && length "$_[0]" );
 176 }
 177
 178 {
 179
 180     # This is a nasty hack around some weird back compat code in
 181     # Catalyst::Controller->action_namespace
 182     package FakeConfig;
 183
 184     sub config {
 185         return { case_sensitive => 0 };
 186     }
 187 }
 188
 189 1;
 190
 191 # ABSTRACT: Sugar for declaring RESTful chained action in Catalyst
 192
 193 __END__
 194
 195 =head1 SYNOPSIS
 196
 197   package MyApp::Controller::User;
 198
 199   use Moose;
 200   use CatalystX::Routes;
 201
 202   BEGIN { extends 'Catalyst::Controller'; }
 203
 204   # /user/:user_id
 205
 206   chain_point '_set_user'
 207       => chained '/'
 208       => path_part 'user'
 209       => capture_args 1
 210       => sub {
 211           my $self = shift;
 212           my $c    = shift;
 213           my $user_id = shift;
 214
 215           $c->stash()->{user} = ...;
 216       };
 217
 218   # GET /user/:user_Id
 219   get ''
 220      => chained('_set_user')
 221      => args 0
 222      => sub { ... };
 223
 224   # GET /user/foo
 225   get 'foo' => sub { ... };
 226
 227   sub _post { ... }
 228
 229   # POST /user/foo
 230   post 'foo' => \&_post;
 231
 232   # PUT /root
 233   put '/root' => sub { ... };
 234
 235   # /user/plain_old_catalyst
 236   sub plain_old_catalyst : Local { ... }
 237
 238 =head1 DESCRIPTION
 239
 240 This module provides a sugar layer that allows controllers to declare chained
 241 RESTful actions.
 242
 243 Under the hood, all the sugar declarations are turned into Chained subs. All
 244 chain end points are declared using one of C<get>, C<get_html>, C<post>,
 245 C<put>, or C<del>. These will declare actions using the
 246 L<Catalyst::Action::REST::ForBrowsers> action class from the
 247 L<Catalyst::Action::REST> distribution.
 248
 249 =head1 PUTTING IT ALL TOGETHER
 250
 251 This module is merely sugar over Catalyst's built-in L<Chained
 252 dispatching|Catalyst::DispatchType::Chained> and L<Catalyst::Action::REST>. It
 253 helps to know how those two things work.
 254
 255 =head1 SUGAR FUNCTIONS
 256
 257 All of these functions will be exported into your controller class when you
 258 use C<CatalystX::Routes>.
 259
 260 =head2 get ...
 261
 262 This declares a C<GET> handler.
 263
 264 =head2 get_html
 265
 266 This declares a C<GET> handler for browsers. Use this to generate a standard
 267 HTML page for browsers while still being able to generate some sort of RESTful
 268 data response for other clients.
 269
 270 If a browser makes a C<GET> request and no C<get_html> action has been
 271 declared, a C<get> action is used as a fallback. See
 272 C<Catalyst::TraitFor::Request::REST::ForBrowsers> for details on how
 273 "browser-ness" is determined.
 274
 275 =head2 post ...
 276
 277 This declares a C<POST> handler.
 278
 279 =head2 put
 280
 281 This declares a C<PUT> handler.
 282
 283 =head2 del
 284
 285 This declares a C<DELETE> handler.
 286
 287 =head2 chain_point
 288
 289 This declares an intermediate chain point that should not be exposed as a
 290 public URI.
 291
 292 =head2 chained $path
 293
 294 This function takes a single argument, the previous chain point from which the
 295 action is chained.
 296
 297 =head2 args $number
 298
 299 This declares the number of arguments that this action expects. This should
 300 only be used for the end of a chain.
 301
 302 =head2 capture_args $number
 303
 304 The number of arguments to capture at this point in the chain. This should
 305 only be used for the beginning or middle parts of a chain.
 306
 307 =head2 path_part $path
 308
 309 The path part for this part of the chain. If you are declaring a chain end
 310 point with C<get>, etc., then this isn't necessary. By default, the name
 311 passed to the initial sugar function will be converted to a path part. See
 312 below for details.
 313
 314 =head2 action_class_name $class
 315
 316 Use this to declare an action class. By default, this will be
 317 L<Catalyst::Action::REST::ForBrowsers> for end points. For other parts of a
 318 chain, it simply won't be set.
 319
 320 =head1 PATH GENERATION
 321
 322 All of the end point function (C<get>, C<post>, etc.) take a path as the first
 323 argument. By default, this will be used as the C<path_part> for the chain. You
 324 can override this by explicitly calling C<path_part>, in which case the name
 325 is essentially ignored (but still required).
 326
 327 Note that it is legitimate to pass the empty string as the name for a chain's
 328 end point.
 329
 330 If the end point's name does not start with a slash, it will be prefixed with
 331 the controller's namespace.
 332
 333 If you don't specify a C<chained> value for an end point, then it will use the
 334 root URI, C</>, as the root of the chain.
 335
 336 By default, no arguments are specified for a chain's end point, meaning it
 337 will accept any number of arguments.
 338
 339 =head1 CAVEATS
 340
 341 When adding subroutines for end points to your controller, a name is generated
 342 for each subroutine based on the chained path to the subroutine. Some
 343 template-based views will automatically pick a template based on the
 344 subroutine's name if you don't specify one explicitly. This won't work very
 345 well with the bizarro names that this module generates, so you are strongly
 346 encouraged to specify a template name explicitly.
 347
 348 =head1 BUGS
 349
 350 Please report any bugs or feature requests to
 351 C<bug-catalystx-routes@rt.cpan.org>, or through the web interface at
 352 L<http://rt.cpan.org>.  I will be notified, and then you'll automatically be
 353 notified of progress on your bug as I make changes.
 354
 355 =cut