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