+Thu Nov 30 23:51:04 PST 2006 (adam)
+ Refactored the Catalyst::Action::REST dispatch, so that the default
+ method is called before any _METHOD handlers. In addition, moved
+ the 405 Not Implemented handler to be foo_not_implemented, instead
+ of the default sub. (daisuke++ pointed out the inconsistency and
+ provided a patch, and I added the foo_not_implemented support)
+
+ Added in automated OPTIONS handler, which constructs the allow
+ header for you, just like the 405 handler. Can be overridden
+ with a normal _METHOD sub.
+
+ Refactored Test::Rest, so that it uses closures to create the
+ very similar $test->method() subs.
+
+ Added tests for Catalyst::Action::REST.
+
Thu Nov 30 17:14:51 PST 2006 (adam) - Release 0.2
Added documentation patch from Daisuke Maki (daisuke@endeworks.jp)
Added dependency patch from Daisuke Maki (daisuke@endeworks.jp)
use Class::Inspector;
use 5.8.1;
-my
+our
$VERSION = '0.2';
=head1 NAME
mechanism described above.
=cut
+
sub dispatch {
my $self = shift;
- my $c = shift;
+ my $c = shift;
my $controller = $self->class;
my $method = $self->name . "_" . uc( $c->request->method );
if ( $controller->can($method) ) {
- return $controller->$method($c, @{$c->req->args});
+ $c->execute( $self->class, $self, @{ $c->req->args } );
+ return $controller->$method( $c, @{ $c->req->args } );
} else {
- $self->_return_405($c);
- return $c->execute( $self->class, $self, @{$c->req->args} );
+ if ( $c->request->method eq "OPTIONS" ) {
+ return $self->_return_options($c);
+ } else {
+ my $handle_ni = $self->name . "_not_implemented";
+ if ( $controller->can($handle_ni) ) {
+ return $controller->$handle_ni( $c, @{ $c->req->args } );
+ } else {
+ return $self->_return_not_implemented($c);
+ }
+ }
}
}
-sub _return_405 {
+sub _return_options {
+ my ( $self, $c ) = @_;
+
+ my @allowed = $self->_get_allowed_methods($c);
+ $c->response->content_type('text/plain');
+ $c->response->status(200);
+ $c->response->header( 'Allow' => \@allowed );
+}
+
+sub _get_allowed_methods {
my ( $self, $c ) = @_;
my $controller = $self->class;
push( @allowed, $1 );
}
}
+ return @allowed;
+}
+
+sub _return_not_implemented {
+ my ( $self, $c ) = @_;
+
+ my @allowed = $self->_get_allowed_methods($c);
$c->response->content_type('text/plain');
$c->response->status(405);
$c->response->header( 'Allow' => \@allowed );
You may distribute this code under the same terms as Perl itself.
=cut
+
--- /dev/null
+package Test::Catalyst::Action::REST;
+
+use FindBin;
+
+use lib ("$FindBin::Bin/../lib");
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+use Catalyst;
+
+__PACKAGE__->config( name => 'Test::Catalyst::Action::REST' );
+__PACKAGE__->setup;
+
+sub test :Local :ActionClass('REST') {
+ my ($self, $c) = @_;
+ $c->stash->{'entity'} = 'something';
+}
+
+sub test_GET :Local :ActionClass('REST') {
+ my ($self, $c) = @_;
+
+ $c->stash->{'entity'} .= " GET";
+ $c->forward('ok');
+}
+
+sub test_POST :Local :ActionClass('REST') {
+ my ($self, $c) = @_;
+
+ $c->stash->{'entity'} .= " POST";
+ $c->forward('ok');
+}
+
+sub test_PUT :Local :ActionClass('REST') {
+ my ($self, $c) = @_;
+
+ $c->stash->{'entity'} .= " PUT";
+ $c->forward('ok');
+}
+
+sub test_DELETE :Local :ActionClass('REST') {
+ my ($self, $c) = @_;
+
+ $c->stash->{'entity'} .= " DELETE";
+ $c->forward('ok');
+}
+
+sub test_OPTIONS :Local :ActionClass('REST') {
+ my ($self, $c) = @_;
+
+ $c->stash->{'entity'} .= " OPTIONS";
+ $c->forward('ok');
+}
+
+sub notreally :Local :ActionClass('REST') { }
+
+sub notreally_GET {
+ my ($self, $c) = @_;
+
+ $c->stash->{'entity'} = "notreally GET";
+ $c->forward('ok');
+}
+
+sub not_implemented :Local :ActionClass('REST') {}
+
+sub not_implemented_GET {
+ my ($self, $c) = @_;
+
+ $c->stash->{'entity'} = "not_implemented GET";
+ $c->forward('ok');
+}
+
+sub not_implemented_not_implemented {
+ my ($self, $c) = @_;
+
+ $c->stash->{'entity'} = "Not Implemented Handler";
+ $c->forward('ok');
+}
+
+sub ok :Private {
+ my ($self, $c) = @_;
+
+ $c->res->content_type('text/plain');
+ $c->res->body($c->stash->{'entity'});
+}
+
+package main;
+
+use strict;
+use warnings;
+use Test::More qw(no_plan);
+use FindBin;
+use Data::Dump qw(dump);
+
+use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib");
+use Test::Rest;
+
+# Should use the default serializer, YAML
+my $t = Test::Rest->new('content_type' => 'text/plain');
+
+use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
+
+foreach my $method (qw(GET DELETE POST PUT OPTIONS)) {
+ my $run_method = lc($method);
+ my $result = "something $method";
+ my $res;
+ if (grep /$method/, qw(GET DELETE OPTIONS)) {
+ $res = request($t->$run_method(url => '/test'));
+ } else {
+ $res = request($t->$run_method(
+ url => '/test',
+ data => { foo => 'bar' }
+ )
+ );
+ }
+ ok( $res->is_success, "$method request succeeded" );
+ is( $res->content, "something $method", "$method request had proper response");
+}
+
+my $fail_res = request($t->delete(url => '/notreally'));
+is( $fail_res->code, 405, "Request to bad method gets 405 Not Implemented");
+is( $fail_res->header('allow'), "GET", "405 allow header properly set.");
+
+my $options_res = request($t->options(url => '/notreally'));
+is( $options_res->code, 200, "OPTIONS request handler succeeded");
+is( $options_res->header('allow'), "GET", "OPTIONS request allow header properly set.");
+
+my $ni_res = request($t->delete(url => '/not_implemented'));
+is( $ni_res->code, 200, "Custom not_implemented handler succeeded");
+is ($ni_res->content, "Not Implemented Handler", "not_implemented handler had proper response");
+
+1;
sub new {
my $self = shift;
- my %p = validate(@_,
- {
- content_type => { type => SCALAR },
- },
- );
- my $ref = {
- 'ua' => LWP::UserAgent->new,
+ my %p = validate( @_, { content_type => { type => SCALAR }, }, );
+ my $ref = {
+ 'ua' => LWP::UserAgent->new,
'content_type' => $p{'content_type'},
};
bless $ref, $self;
}
-sub get {
- my $self = shift;
- my %p = validate(@_,
- {
- url => { type => SCALAR },
- },
- );
- my $req = HTTP::Request->new('GET' => $p{'url'});
- $req->content_type($self->{'content_type'});
- return $req;
-}
-
-sub delete {
- my $self = shift;
- my %p = validate(@_,
- {
- url => { type => SCALAR },
- },
- );
- my $req = HTTP::Request->new('DELETE' => $p{'url'});
- $req->content_type($self->{'content_type'});
- return $req;
-}
+{
+ my @non_data_methods = qw(GET DELETE OPTIONS);
+ foreach my $method (@non_data_methods) {
+ no strict 'refs';
+ my $sub = lc($method);
+ *$sub = sub {
+ my $self = shift;
+ my %p = validate( @_, { url => { type => SCALAR }, }, );
+ my $req = HTTP::Request->new( "$method" => $p{'url'} );
+ $req->content_type( $self->{'content_type'} );
+ return $req;
+ };
+ }
-sub put {
- my $self = shift;
- my %p = validate(@_,
- {
- url => { type => SCALAR },
- data => 1,
- },
- );
- my $req = HTTP::Request->new('PUT' => $p{'url'});
- $req->content_type($self->{'content_type'});
- $req->content_length(do { use bytes; length($p{'data'}) });
- $req->content($p{'data'});
- return $req;
+ my @data_methods = qw(PUT POST);
+ foreach my $method (@data_methods) {
+ no strict 'refs';
+ my $sub = lc($method);
+ *{$sub} = sub {
+ my $self = shift;
+ my %p = validate(
+ @_,
+ {
+ url => { type => SCALAR },
+ data => 1,
+ },
+ );
+ my $req = HTTP::Request->new( "$method" => $p{'url'} );
+ $req->content_type( $self->{'content_type'} );
+ $req->content_length(
+ do { use bytes; length( $p{'data'} ) }
+ );
+ $req->content( $p{'data'} );
+ return $req;
+ };
+ }
}
-sub post {
- my $self = shift;
- my %p = validate(@_,
- {
- url => { type => SCALAR },
- data => { required => 1 },
- },
- );
- my $req = HTTP::Request->new('POST' => $p{'url'});
- $req->content_type($self->{'content_type'});
- $req->content_length(do { use bytes; length($p{'data'}) });
- $req->content($p{'data'});
- return $req;
-}
-
-
1;