new match and match captutres for http methods, plus tests, docs
John Napiorkowski [Mon, 11 Feb 2013 22:22:07 +0000 (17:22 -0500)]
Changes
lib/Catalyst/Action.pm
lib/Catalyst/Controller.pm
t/aggregate/live_component_controller_httpmethods.t [new file with mode: 0644]
t/lib/TestApp/Controller/Action/Chained.pm
t/lib/TestApp/Controller/HTTPMethods.pm [new file with mode: 0644]

diff --git a/Changes b/Changes
index 05ac845..a1eb91b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,16 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+5.90020 - TBA
+  ! Catalyst::Action now defines 'match_captures' so it is no long considered
+    an optional method.  This might break you code if you have made custom
+    action roles/classes where you define 'match_captures'.  You must change
+    your code to use a method modifier (such as 'around').
+  - New match method "Method($HTTP_METHOD)" where $HTTP_METHOD in (GET, POST,
+    PUT, HEAD, DELETE, OPTION) and shortcuts in controllers called "GET, POST
+    PUT, HEAD, DELETE, OPTION").  Tests and superficial docs (sorry)
+  - security fixes in the way we handle redirects
   - Make Catalyst::Engine and Catalyst::Base immutable
+  - Some test and documentation improvements
 
 5.90019 - 2012-12-04 21:31:00
   - Fix for perl 5.17.6 (commit g7dc8663). RT#81601
index af60527..fb5c9c6 100644 (file)
@@ -65,15 +65,47 @@ sub execute {
   $self->code->(@_);
 }
 
+sub match_captures { 
+  my ( $self, $c, $captures ) = @_;
+  ## It would seem that now that we can match captures, we could remove a lot
+  ## of the capture_args to args mapping all around.  I gave it a go, but was
+  ## not trival, contact jnap on irc for what I tried if you want to try.
+  ##  return $self->_match_has_expected_capture_args($captures) &&
+    return $self->_match_has_expected_http_method($c->req->method);
+}
+
 sub match {
-    my ( $self, $c ) = @_;
-    #would it be unreasonable to store the number of arguments
-    #the action has as its own attribute?
-    #it would basically eliminate the code below.  ehhh. small fish
-    return 1 unless exists $self->attributes->{Args};
-    my $args = $self->attributes->{Args}[0];
-    return 1 unless defined($args) && length($args);
-    return scalar( @{ $c->req->args } ) == $args;
+  my ( $self, $c ) = @_;
+  return $self->_match_has_expected_args($c->req->args) &&
+    $self->_match_has_expected_http_method($c->req->method);
+}
+
+sub _match_has_expected_args {
+  my ($self, $req_args) = @_;
+  return 1 unless exists $self->attributes->{Args};
+  my $args = $self->attributes->{Args}[0];
+  return 1 unless defined($args) && length($args);
+  return scalar( @{$req_args} ) == $args;
+}
+
+sub _match_has_expected_capture_args {
+  my ($self, $req_args) = @_;
+  return 1 unless exists $self->attributes->{CaptureArgs};
+  my $args = $self->attributes->{CaptureArgs}[0];
+  return 1 unless defined($args) && length($args);
+  return scalar( @{$req_args} ) == $args;
+}
+
+sub _match_has_expected_http_method {
+  my ($self, $method) = @_;
+  my @methods = @{ $self->attributes->{Method} || [] };
+  if(scalar @methods) {
+    my $result = scalar(grep { lc($_) eq lc($method) } @methods) ? 1:0;
+    return $result;
+  } else {
+    ## No HTTP Methods to check
+    return 1;
+  }
 }
 
 sub compare {
@@ -138,6 +170,16 @@ context and arguments
 Check Args attribute, and makes sure number of args matches the setting.
 Always returns true if Args is omitted.
 
+=head2 match_captures ($c, $captures)
+
+Can be implemented by action class and action role authors. If the method
+exists, then it will be called with the request context and an array reference
+of the captures for this action.
+
+Returning true from this method causes the chain match to continue, returning
+makes the chain not match (and alternate, less preferred chains will be attempted).
+
+
 =head2 compare
 
 Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
@@ -172,17 +214,6 @@ Returns the number of captures this action expects for L<Chained|Catalyst::Dispa
 
 Provided by Moose.
 
-=head1 OPTIONAL METHODS
-
-=head2 match_captures
-
-Can be implemented by action class and action role authors. If the method
-exists, then it will be called with the request context and an array reference
-of the captures for this action.
-
-Returning true from this method causes the chain match to continue, returning
-makes the chain not match (and alternate, less preferred chains will be attempted).
-
 =head1 AUTHORS
 
 Catalyst Contributors, see Catalyst.pm
index ce68f8e..cc2da5e 100644 (file)
@@ -545,6 +545,13 @@ sub _parse_Does_attr {
     return Does => $self->_expand_role_shortname($value);
 }
 
+sub _parse_GET_attr { Method => 'GET' }
+sub _parse_POST_attr { Method => 'POST' }
+sub _parse_PUT_attr { Method => 'PUT' }
+sub _parse_DELETE_attr { Method => 'DELETE' }
+sub _parse_OPTION_attr { Method => 'OPTION' }
+sub _parse_HEAD_attr { Method => 'HEAD' }
+
 sub _expand_role_shortname {
     my ($self, @shortnames) = @_;
     my $app = $self->_application;
diff --git a/t/aggregate/live_component_controller_httpmethods.t b/t/aggregate/live_component_controller_httpmethods.t
new file mode 100644 (file)
index 0000000..d1bc2de
--- /dev/null
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+use Test::More;
+use HTTP::Request::Common qw/GET POST DELETE PUT /;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Catalyst::Test 'TestApp';
+is(request(GET    '/httpmethods/foo')->content, 'get');
+is(request(POST   '/httpmethods/foo')->content, 'post');
+is(request(DELETE '/httpmethods/foo')->content, 'default');
+is(request(GET    '/httpmethods/bar')->content, 'get or post');
+is(request(POST   '/httpmethods/bar')->content, 'get or post');
+is(request(DELETE '/httpmethods/bar')->content, 'default');
+is(request(GET    '/httpmethods/baz')->content, 'any');
+is(request(POST   '/httpmethods/baz')->content, 'any');
+is(request(DELETE '/httpmethods/baz')->content, 'any');
+
+is(request(GET    '/httpmethods/chained_get')->content, 'chained_get');
+is(request(POST    '/httpmethods/chained_post')->content, 'chained_post');
+is(request(PUT    '/httpmethods/chained_put')->content, 'chained_put');
+is(request(DELETE    '/httpmethods/chained_delete')->content, 'chained_delete');
+
+is(request(GET '/httpmethods/get_put_post_delete')->content, 'get2');
+is(request(POST '/httpmethods/get_put_post_delete')->content, 'post2');
+is(request(PUT '/httpmethods/get_put_post_delete')->content, 'put2');
+is(request(DELETE '/httpmethods/get_put_post_delete')->content, 'delete2');
+
+is(request(GET '/httpmethods/check_default')->content, 'get3');
+is(request(POST '/httpmethods/check_default')->content, 'post3');
+is(request(PUT '/httpmethods/check_default')->content, 'chain_default');
+
+
+done_testing;
index 732a35b..5fa5f22 100644 (file)
@@ -20,7 +20,7 @@ sub begin :Private { }
 sub foo  :PathPart('chained/foo')  :CaptureArgs(1) :Chained('/') {
     my ( $self, $c, @args ) = @_;
     die "missing argument" unless @args;
-    die "more than 1 argument" if @args > 1;
+    die "more than 1 argument: got @args" if @args > 1;
 }
 sub endpoint  :PathPart('end')  :Chained('/action/chained/foo')  :Args(1) { }
 
diff --git a/t/lib/TestApp/Controller/HTTPMethods.pm b/t/lib/TestApp/Controller/HTTPMethods.pm
new file mode 100644 (file)
index 0000000..759f9fa
--- /dev/null
@@ -0,0 +1,88 @@
+package TestApp::Controller::HTTPMethods;
+
+use Moose;
+use MooseX::MethodAttributes;
+extends 'Catalyst::Controller';
+sub default : Path Args {
+    my ($self, $ctx) = @_;
+    $ctx->response->body('default');
+}
+sub get : Path('foo') Method('GET') {
+    my ($self, $ctx) = @_;
+    $ctx->response->body('get');
+}
+sub post : Path('foo') Method('POST') {
+    my ($self, $ctx) = @_;
+    $ctx->response->body('post');
+}
+sub get_or_post : Path('bar') Method('GET') Method('POST') {
+    my ($self, $ctx) = @_;
+    $ctx->response->body('get or post');
+}
+sub any_method : Path('baz') {
+    my ($self, $ctx) = @_;
+    $ctx->response->body('any');
+}
+
+sub base :Chained('/') PathPrefix CaptureArgs(0) { }
+
+  sub chained_get :Chained('base') Args(0) GET {
+    pop->res->body('chained_get');
+  }
+
+  sub chained_post :Chained('base') Args(0) POST {
+    pop->res->body('chained_post');
+  }
+
+  sub chained_put :Chained('base') Args(0) PUT {
+    pop->res->body('chained_put');
+  }
+
+  sub chained_delete :Chained('base') Args(0) DELETE {
+    pop->res->body('chained_delete');
+  }
+
+  sub get_or_put :Chained('base') PathPart('get_put_post_delete')
+    : CaptureArgs(0) GET PUT { }
+
+    sub get2 :Chained('get_or_put') PathPart('') Args(0) GET {
+      pop->res->body('get2');
+    }
+    
+    sub put2 :Chained('get_or_put') PathPart('') Args(0) PUT {
+      pop->res->body('put2');
+    }
+
+  sub post_or_delete :Chained('base') PathPart('get_put_post_delete')
+    : CaptureArgs(0) POST DELETE { }
+
+    sub post2 :Chained('post_or_delete') PathPart('') Args(0) POST {
+      pop->res->body('post2');
+    }
+    
+    sub delete2 :Chained('post_or_delete') PathPart('') Args(0) DELETE {
+      pop->res->body('delete2');
+    }
+
+  sub check_default :Chained('base') CaptureArgs(0) { }
+
+    sub default_get :Chained('check_default') PathPart('') Args(0) GET {
+      pop->res->body('get3');
+    }
+
+    sub default_post :Chained('check_default') PathPart('') Args(0) POST {
+      pop->res->body('post3');
+    }
+
+    sub chain_default :Chained('check_default') PathPart('') Args(0) {
+      pop->res->body('chain_default');
+    }
+
+
+__PACKAGE__->meta->make_immutable;