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