allow under specification inside action syntax via <-

diff --git a/lib/CatalystX/Declarative/Keyword/Action.pm b/lib/CatalystX/Declarative/Keyword/Action.pm
index 5621f24..b87f72b 100644 (file)
--- a/lib/CatalystX/Declarative/Keyword/Action.pm
+++ b/lib/CatalystX/Declarative/Keyword/Action.pm
@@ -98,7 +98,6 @@ class CatalystX::Declarative::Keyword::Action
         }
 
         if ($attributes{Private}) {
-#            warn "PRIVATE $name";
             delete $attributes{ $_ }
                 for qw( Args CaptureArgs Chained Signature Subname Action );
         }
@@ -124,7 +123,6 @@ class CatalystX::Declarative::Keyword::Action
                 : "($attributes{ $_ })"
             );
         } keys %attributes;
-#        warn "ATTRS[ @attributes ]\n";
 
         return $ctx->shadow(sub (&) {
             my $class = caller;
@@ -181,6 +179,16 @@ class CatalystX::Declarative::Keyword::Action
         my $name = $ctx->strip_name
             or croak "Anonymous actions not yet supported";
 
+        $ctx->skipspace;
+        my $populator;
+
+        if (substr($ctx->get_linestr, $ctx->offset, 2) eq '<-') {
+            my $linestr = $ctx->get_linestr;
+            substr($linestr, $ctx->offset, 2) = '';
+            $ctx->set_linestr($linestr);
+            $populator = $self->_handle_under_option($ctx, $attrs);
+        }
+
         # signature
         my $proto = $ctx->strip_proto || '';
         $proto = join(', ', 'Object $self: Object $ctx', $proto || ());
@@ -193,7 +201,8 @@ class CatalystX::Declarative::Keyword::Action
             $attrs->{Chained} ||= $CatalystX::Declarative::SCOPE::UNDER;
         }
 
-        return;
+        return unless $populator;
+        return $populator;
     }
 
     method _handle_final_option (Object $ctx, HashRef $attrs) {

diff --git a/t/001_basic.t b/t/001_basic.t
index a5d9214..b6e112a 100644 (file)
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -5,7 +5,7 @@ use warnings;
 use FindBin;
 use lib "$FindBin::Bin/lib";
 
-use Test::More tests => 16;
+use Test::More tests => 17;
 use Catalyst::Test 'TestApp';
 
 # simple stuff
@@ -47,3 +47,6 @@ is get('/foo/finals/final_at_end'), 'foo/final_at_end', 'final syntax element at
 
 # privates
 is get('/foo/expose_not_really_here'), 23, 'private action works';
+
+# specify chain target directly via action
+is get('/foo/pointed/beaver'), 'Your beaver is pointed!', 'chain target specified via action';

diff --git a/t/lib/TestApp/Controller/Foo.pm b/t/lib/TestApp/Controller/Foo.pm
index 9c7c085..bab5f2f 100644 (file)
--- a/t/lib/TestApp/Controller/Foo.pm
+++ b/t/lib/TestApp/Controller/Foo.pm
@@ -193,5 +193,12 @@ controller TestApp::Controller::Foo {
         $ctx->forward('not_really_here');
         $ctx->response->body($ctx->stash->{foo});
     }
+
+
+    #
+    #   chain target specified via action
+    #
+
+    action pointed <- base ($what) is final { $ctx->response->body("Your $what is pointed!") }
 }