implemented action dispatching by type
Robert 'phaylon' Sedlacek [Fri, 21 Aug 2009 21:04:57 +0000 (23:04 +0200)]
14 files changed:
Changes
examples/MyApp-Web/t/02functionality.t
lib/CatalystX/Declare/Action/CatchValidationError.pm
lib/CatalystX/Declare/Controller/ActionPreparation.pm [new file with mode: 0644]
lib/CatalystX/Declare/Controller/RegisterActionRoles.pm [deleted file]
lib/CatalystX/Declare/Dispatching/ChainTypeSensitivity.pm [new file with mode: 0644]
lib/CatalystX/Declare/Keyword/Action.pm
lib/CatalystX/Declare/Keyword/Controller.pm
t/051_modifier_signatures.t
t/060_exception_handling.t
t/061_signature_matching.t [new file with mode: 0644]
t/100_complex.t
t/lib/TestApp/Controller/Foo.pm
t/lib/TestApp/Controller/SignatureMatching.pm [new file with mode: 0644]

diff --git a/Changes b/Changes
index bd50c39..ece6ef1 100644 (file)
--- a/Changes
+++ b/Changes
@@ -4,6 +4,8 @@
     - documented 'isa' action class option (experimental!)
     - fixed bug where setup wasn't called without plugins
     - fixed bug where under block scope wasn't cleaned up
+    - action signatures now influence dispatching, non-matching actinos
+      will be skipped by the chained dispatch type
 
 [0.008] Tue Aug 18 19:59:57 CEST 2009
     - default_inner now ignores arguments
index 0ccdf0e..b6d8c56 100644 (file)
@@ -15,13 +15,13 @@ is get('/calc/add/3/4/5'), 12, 'addition';
 is get('/calc/multiply/2/3/4'), 24, 'multiplication';
 
 is get('/calc/unknownthingy/3/4/5'), 'unknown operator', 'unknown operator';
-is get('/calc/add/3/f/5'), 'Not found', 'bad request';
+is get('/calc/add/3/f/5'), 'Page Not Found', 'bad request';
 
 like get('/foo/hello'), qr/root controller role/, 'root controller role';
 
 is get('/foo/2/3/add'), 5, 'add two';
 is get('/foo/2/3/multiply'), 6, 'multiply two';
 
-is get('/foo/2/f/add'), 'Not found', 'bad request capture args';
+is get('/foo/2/f/add'), 'Page Not Found', 'bad request capture args';
 
 done_testing;
index 585b793..2902a83 100644 (file)
@@ -4,38 +4,33 @@ role CatalystX::Declare::Action::CatchValidationError {
 
     use TryCatch;
 
-    around execute (Object $controller, Object $ctx, @rest) {
-
-        my $tc = $controller->meta->find_method_type_constraint($self->name)
-              || do {
-                   my $method = $controller->meta->find_method_by_name($self->name);
-                   ( $_ = $method->can('type_constraint') )
-                     ? $method->$_
-                     : undef
-                 };
-
-        if ($tc and my $error = $tc->validate([$controller, $ctx, @rest])) {
-
-            if ($ctx->debug) {
-                $ctx->error("BAD REQUEST: $error");
-            }
-            else {
-                $ctx->response->body( 'Not found' );
-                $ctx->response->status( 404 );
-            }
-            
-            $ctx->detach;
-        }
-
-        try {
-            $self->$orig($controller, $ctx, @rest);
-        }
-        catch (Any $error) {
-
-            $ctx->error($error);
-            $ctx->detach;
-        }
-
-        return 1;
+    use aliased 'Moose::Meta::TypeConstraint';
+
+    has method_type_constraint => (
+        is          => 'rw',
+        isa         => TypeConstraint,
+        handles     => {
+            _check_action_arguments => 'check',
+        },
+    );
+
+    has controller_instance => (
+        is          => 'rw',
+        isa         => 'Catalyst::Controller',
+        weak_ref    => 1,
+    );
+
+    around match (Object $ctx) {
+
+        return 
+            unless $self->$orig($ctx);
+        return 1 
+            unless $self->method_type_constraint;
+
+        my @args    = ($self->controller_instance, $ctx, @{ $ctx->req->args });
+        my $tc      = $self->method_type_constraint;
+        my $ret     = $self->_check_action_arguments(\@args);
+
+        return $ret;
     }
 }
diff --git a/lib/CatalystX/Declare/Controller/ActionPreparation.pm b/lib/CatalystX/Declare/Controller/ActionPreparation.pm
new file mode 100644 (file)
index 0000000..720a9a7
--- /dev/null
@@ -0,0 +1,75 @@
+use MooseX::Declare;
+
+role CatalystX::Declare::Controller::ActionPreparation {
+
+    use aliased 'CatalystX::Declare::Action::CatchValidationError';
+    use aliased 'CatalystX::Declare::Dispatching::ChainTypeSensitivity';
+
+
+    method _apply_action_roles (Object $action, @roles) {
+
+        for my $role (CatchValidationError, @roles) {
+            my $fq_role = $self->_qualify_class_name(ActionRole => $role);
+
+            Class::MOP::load_class($fq_role);
+            $fq_role->meta->apply($action);
+        }
+    }
+
+    method _find_method_type_constraint (Str $name) {
+
+        $self->meta->find_method_type_constraint($name)
+            || do {
+                my $method = $self->meta->find_method_by_name($name);
+                    ( $_ = $method->can('type_constraint') )
+                    ? $method->$_
+                    : undef
+            };
+    }
+
+    method _ensure_applied_dispatchtype_roles {
+
+        my $type = $self->_app->dispatcher->dispatch_type('Chained');
+
+        return
+            if $type->DOES(ChainTypeSensitivity);
+
+        # FIXME this is ugly as hell
+        my $immutable = $type->meta->is_immutable;
+        $type->meta->make_mutable
+            if $immutable;
+        ChainTypeSensitivity->meta->apply($type->meta);
+        $type->meta->make_immutable
+            if $immutable;
+    }
+
+    after register_actions {
+
+        $self->_ensure_applied_dispatchtype_roles;
+    }
+
+    around create_action (%args) {
+
+        my @action_roles = @{ delete($args{attributes}{CatalystX_Declarative_ActionRoles}) || [] };
+
+        my $action = $self->$orig(%args);
+
+        return $action
+            if $args{attributes}{Private};
+
+        $self->_apply_action_roles($action, @action_roles);
+
+        return $action 
+            unless $action->DOES(CatchValidationError);
+
+        my $tc = $self->_find_method_type_constraint($action->name);
+
+        return $action
+            unless $tc;
+
+        $action->method_type_constraint($tc);
+        $action->controller_instance($self);
+
+        return $action;
+    }
+}
diff --git a/lib/CatalystX/Declare/Controller/RegisterActionRoles.pm b/lib/CatalystX/Declare/Controller/RegisterActionRoles.pm
deleted file mode 100644 (file)
index e42a332..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-use MooseX::Declare;
-use Class::MOP;
-
-role CatalystX::Declare::Controller::RegisterActionRoles 
-    with CatalystX::Declare::Controller::QualifyClassNames {
-
-    around create_action (%args) {
-
-        my @action_roles = @{ delete($args{attributes}{CatalystX_Declarative_ActionRoles}) || [] };
-
-        my $action = $self->$orig(%args);
-
-        for my $role (@action_roles) {
-            my $fq_role = $self->_qualify_class_name(ActionRole => $role);
-
-            Class::MOP::load_class($fq_role);
-            $fq_role->meta->apply($action);
-        }
-
-        return $action;
-    }
-}
-
-1;
diff --git a/lib/CatalystX/Declare/Dispatching/ChainTypeSensitivity.pm b/lib/CatalystX/Declare/Dispatching/ChainTypeSensitivity.pm
new file mode 100644 (file)
index 0000000..6a2b3ca
--- /dev/null
@@ -0,0 +1,37 @@
+use MooseX::Declare;
+
+role CatalystX::Declare::Dispatching::ChainTypeSensitivity {
+
+    use constant CatchValidationError => 'CatalystX::Declare::Action::CatchValidationError';
+
+    our @LastPathParts;
+
+
+    around recurse_match ($ctx, Str $parent, ArrayRef $path_parts) {
+
+        my @last_path_parts  = @LastPathParts;
+        local @LastPathParts = @$path_parts;
+
+        my $action = $ctx->dispatcher->get_action_by_path($parent);
+
+        if ($action and $action->DOES(CatchValidationError)) {
+
+            my @action_parts   = @last_path_parts[0 .. ( $#last_path_parts - @$path_parts )];
+            my $path_part_spec = ( @{ $action->attributes->{PathPart} || [] } )[0];
+            $path_part_spec    = $action->name
+                unless defined $path_part_spec;
+            my @name_parts     = grep { $_ ne '' } split qr{/}, $path_part_spec;
+
+            shift @action_parts
+                for 0 .. $#name_parts;
+
+            my $tc   = $action->method_type_constraint;
+            my $ctrl = $action->controller_instance;
+
+            return ()
+                unless $tc->check([$ctrl, $ctx, @action_parts]);
+        }
+
+        $self->$orig($ctx, $parent, $path_parts);
+    }
+}
index f29fab8..2cecb1f 100644 (file)
@@ -108,7 +108,7 @@ class CatalystX::Declare::Keyword::Action
 
         if ($attributes{Private}) {
             delete $attributes{ $_ }
-                for qw( Args CaptureArgs Chained Signature Subname Action );
+                for qw( Args CaptureArgs Chained Signature Private );
         }
 
         if ($ctx->peek_next_char eq '{') {
@@ -396,6 +396,10 @@ CatalystX::Declare::Keyword::Action - Declare Catalyst Actions
             # the final keyword can be used to be more 
             # visually explicit about end-points
             final action some_action { ... }
+
+            # type dispatching works
+            final action with_str (Str $x) as via_type;
+            final action with_int (Int $x) as via_type;
         }
 
         # of course you can also chain to external actions
@@ -535,8 +539,8 @@ specify an action after a C<E<lt>-> following the action name:
 =head2 Arguments
 
 You can use signatures like you are use to from L<MooseX::Method::Signatures>
-to declare action parameters. The number of arguments will be used during 
-dispatching. Dispatching by type constraint is planned but not yet implemented.
+to declare action parameters. The number of positinoal arguments will be used 
+during dispatching as well as their types.
 
 The signature follows the action name:
 
@@ -568,11 +572,25 @@ an array as a variable:
 
 =head2 Validation
 
-Currently, when the arguments do not fit the signature because of a L<Moose>
-validation error, the response body will be set to C<Not found> and the
-status to C<404>. This only applies when debug mode is off. If it is turned on,
-the error message will be prefixed with C<BAD REQUEST: >. The action will 
-automatically detach after a failed signature validation.
+The signatures are now validated during dispatching-time, and an action with
+a non-matching signature (number of positional arguments and their types) will
+not be dispatched to. This means that
+
+    action base under '/' as '';
+
+    under base {
+
+        final as double, action double_string (Str $x) {
+            $ctx->response->body( $x x 2 );
+        }
+
+        final as double, action double_integer (Int $x) {
+            $ctx->response->body( $x * 2 );
+        }
+    }
+
+will return C<foofoo> when called as C</double/foo> and C<46> when called as
+C</double/23>.
 
 =head2 Actions and Method Modifiers
 
index 789229a..8d8aaca 100644 (file)
@@ -8,7 +8,7 @@ class CatalystX::Declare::Keyword::Controller
     use aliased 'CatalystX::Declare::Keyword::Action', 'ActionKeyword';
     use aliased 'CatalystX::Declare::Controller::DetermineActionClass';
     use aliased 'CatalystX::Declare::Controller::Meta::TypeConstraintMapping';
-    use aliased 'CatalystX::Declare::Controller::RegisterActionRoles';
+    use aliased 'CatalystX::Declare::Controller::ActionPreparation';
 
     use Data::Dump qw( pp );
 
@@ -29,8 +29,8 @@ class CatalystX::Declare::Keyword::Controller
 
         $ctx->add_scope_code_parts(
             sprintf('with qw( %s )', join ' ',
-                RegisterActionRoles,
                 DetermineActionClass,
+                ActionPreparation,
             ),
         );
     }
@@ -132,7 +132,7 @@ developing L<CatalystX::Declare>, you should not be concerned with them.
 
 This method modifier will initialise the controller with 
 L<MooseX::MethodAttributes> and add the 
-L<CatalystX::Declare::Controller::RegisterActionRoles> and
+L<CatalystX::Declare::Controller::ActionPreparation> and
 L<CatalystX::Declare::Controller::DetermineActionClass> controller roles
 before calling the original.
 
index 6138f42..70f6f23 100644 (file)
@@ -11,7 +11,7 @@ use Catalyst::Test 'TestApp';
 is get('/modsig/foo/2/3'),      'modifiersignatures/foo modified', 'intended arguments work';
 is get('/modsig/foo/2'),        'Page Not Found', 'missing argument leads to 404';
 is get('/modsig/foo/2/3/4'),    'Page Not Found', 'one argument too many leads to 404';
-is get('/modsig/foo/a/b'),      'Not found', 'invalid arguments lead to bad request';
+is get('/modsig/foo/a/b'),      'Page Not Found', 'invalid arguments lead to bad request';
 
 
 done_testing;
index e0450bb..56c15fe 100644 (file)
@@ -18,10 +18,6 @@ my $modget = sub { get(join '/', '/sub_errors/signature_error_on_foo_modify', @_
 
 local *TestApp::debug = sub { 0 };
 
-is $get->('foo'),       'Not found', 'detected action signature error';
-is $subget->('foo'),    'Not found', 'detected action signature error (child)';
-is $modget->('foo'),    'Not found', 'detected action signature error (modified)';
-
 stderr_like {
 
     like $get->('bar'),     qr/come back later/i, 'normal handling of method validation error';
@@ -47,54 +43,6 @@ is $modget->('baz'),    'FOO_MODIFY BAR', 'make sure all works without any error
 
 local *TestApp::debug = sub { 1 };
 
-stderr_like {
-
-    my $foo_err = $get->('foo');
-    like $foo_err, qr/BAD REQUEST: /, 'debug version of bad request error';
-    like $foo_err, qr/Validation failed/i, 'debug version of bad request contains error message';
-
-} qr/BAD REQUEST:.+Validation failed/i, 'debug output with bad request note and error message';
-
-stderr_like {
-
-    my $foo_err = $subget->('foo');
-    like $foo_err, qr/BAD REQUEST: /, 'debug version of bad request error (child)';
-    like $foo_err, qr/Validation failed/i, 'debug version of bad request contains error message (child)';
-
-} qr/BAD REQUEST:.+Validation failed/i, 'debug output with bad request note and error message (child)';
-
-stderr_like {
-
-    my $foo_err = $modget->('foo');
-    like $foo_err, qr/BAD REQUEST: /, 'debug version of bad request error (modified)';
-    like $foo_err, qr/Validation failed/i, 'debug version of bad request contains error message (modified)';
-
-} qr/BAD REQUEST:.+Validation failed/i, 'debug output with bad request note and error message (modified)';
-
-stderr_like {
-
-    my $bar_err = $get->('bar');
-    unlike $bar_err, qr/BAD REQUEST: /, 'debug version of method error contains no bad request note';
-    like $bar_err, qr/Validation failed/i, 'we got the right error message';
-
-} qr/Validation failed/i, 'error message reaches stdout';
-
-stderr_like {
-
-    my $bar_err = $subget->('bar');
-    unlike $bar_err, qr/BAD REQUEST: /, 'debug version of method error contains no bad request note (child)';
-    like $bar_err, qr/Validation failed/i, 'we got the right error message (child)';
-
-} qr/Validation failed/i, 'error message reaches stdout (child)';
-
-stderr_like {
-
-    my $bar_err = $modget->('bar');
-    unlike $bar_err, qr/BAD REQUEST: /, 'debug version of method error contains no bad request note (modified)';
-    like $bar_err, qr/Validation failed/i, 'we got the right error message (modified)';
-
-} qr/Validation failed/i, 'error message reaches stdout (modified)';
-
 stderr_unlike {
 
     is $get->('baz'), 'FOO BAR', 'make sure all works without any errors happening in debug mode';
diff --git a/t/061_signature_matching.t b/t/061_signature_matching.t
new file mode 100644 (file)
index 0000000..3b9c4eb
--- /dev/null
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+no warnings 'redefine';
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More; 
+use Catalyst::Test 'TestApp';
+
+
+is get('/sigmatch/test/23'), 'signaturematching/int', 'integer argument dispatched correctly';
+is get('/sigmatch/test/foo'), 'signaturematching/str', 'string argument dispatched correctly';
+is get('/sigmatch/test/f00'), 'signaturematching/rest', 'no match leads to other dispatched action';
+
+done_testing;
index 93df766..c982ce5 100644 (file)
@@ -62,7 +62,7 @@ is get('/foo/surrounded_target'), 'foo/surrounded_target surrounded', 'action wa
 is get('/foo/inline_class'), 'HELLO', 'inline classes work as expected';
 
 # error handling
-is get('/foo/wants_integer/butdoesntgetone'), 'Not found', 'validation error causes bad request error';
+is get('/foo/wants_integer/butdoesntgetone'), 'no integer', 'validation error causes bad request error';
 
 # fix bug with capture args below under { }
 is get('/foo/lower/down/the/param/3/road/5'), 8, 'capture args and block under work together';
index 89b7535..4ab42fd 100644 (file)
@@ -250,5 +250,9 @@ controller ::Controller::Foo with ::TestRole {
         $ctx->response->body($x);
     }
 
+    final action wants_integer_fail (Any $x) as 'wants_integer' under base {
+        $ctx->response->body('no integer');
+    }
+
 }
 
diff --git a/t/lib/TestApp/Controller/SignatureMatching.pm b/t/lib/TestApp/Controller/SignatureMatching.pm
new file mode 100644 (file)
index 0000000..f787f78
--- /dev/null
@@ -0,0 +1,18 @@
+use CatalystX::Declare;
+
+controller TestApp::Controller::SignatureMatching {
+
+    action base as 'sigmatch' under '/';
+
+    under base {
+
+        final action int (Int $x) 
+            as 'test' { $ctx->response->body( $ctx->action->reverse ) }
+
+        final action str (Str $x where { /^[a-z]+$/ }) 
+            as 'test' { $ctx->response->body( $ctx->action->reverse ) }
+
+        final action rest (@) 
+            as '' { $ctx->response->body( $ctx->action->reverse ) }
+    }
+}