Added chain_point to create a non-REST chain point - added tests

diff --git a/lib/CatalystX/Routes.pm b/lib/CatalystX/Routes.pm
index dabfcae..0e9b395 100644 (file)
--- a/lib/CatalystX/Routes.pm
+++ b/lib/CatalystX/Routes.pm
@@ -6,13 +6,14 @@ use warnings;
 use CatalystX::Routes::Role::Class;
 use CatalystX::Routes::Role::Controller;
 use Moose::Util qw( apply_all_roles );
-use Params::Util qw( _STRING _CODELIKE );
+use Params::Util qw( _CODELIKE _REGEX _STRING );
 use Scalar::Util qw( blessed );
+use Sub::Identify qw( sub_name );
 
 use Moose::Exporter;
 
 Moose::Exporter->setup_import_methods(
-    with_meta       => [qw( get get_html post put del )],
+    with_meta       => [qw( get get_html post put del chain_point )],
     as_is           => [qw( chained args capture_args path_part action )],
     class_metaroles => {
         class => ['CatalystX::Routes::Role::Class'],
@@ -55,24 +56,17 @@ sub _add_route {
     return;
 }
 
-sub chained ($) {
-    return ( Chained => [ $_[0] ] );
-}
-
-sub args ($) {
-    return ( Args => [ $_[0] ] );
-}
-
-sub capture_args ($) {
-    return ( CaptureArgs => [ $_[0] ] );
+sub chain_point {
+    my $meta = shift;
+    my $name = shift;
+    _add_chain_point( $meta, $name, chain_point => 1, @_ );
 }
 
-sub path_part ($) {
-    return ( PathPart => [ $_[0] ] );
-}
+sub _add_chain_point {
+    my $meta = shift;
+    my ( $name, $attrs, $sub ) = _process_args( $meta, @_ );
 
-sub action ($) {
-    return ( ActionClass => [ $_[0] ] );
+    $meta->add_chain_point( $name => [ $attrs, $sub ] );
 }
 
 sub _process_args {
@@ -91,26 +85,31 @@ sub _process_args {
 
     my %p = @_;
 
-    $p{ActionClass} ||= 'REST::ForBrowsers';
-
-    unless ( exists $p{Chained} ) {
-        $p{Chained} = q{/};
+    unless ( delete $p{chain_point} ) {
+        $p{ActionClass} ||= 'REST::ForBrowsers';
     }
 
     unless ( $p{PathPart} ) {
         my $part = $path;
-        unless ( $part =~ s{^/}{} ) {
-            $part = join q{/},
-                $meta->name()->action_namespace('FakeConfig'), $part;
+
+        unless ( exists $p{Chained} ) {
+            unless ( $part =~ s{^/}{} ) {
+                $part = join q{/},
+                    $meta->name()->action_namespace('FakeConfig'), $part;
+            }
         }
 
         $p{PathPart} = [$part];
     }
 
-    unless ( $p{Args} ) {
+    unless ( $p{CaptureArgs} || $p{Args} ) {
         $p{Args} = [0];
     }
 
+    unless ( exists $p{Chained} ) {
+        $p{Chained} = q{/};
+    }
+
     ( my $name = $path ) =~ s/(\W)/'X' . sprintf( '%x', ord($1) )/eg;
 
     return $name, \%p, $sub;
@@ -140,6 +139,26 @@ sub _maybe_add_rest_route {
     return;
 }
 
+sub chained ($) {
+    return ( Chained => $_[0] );
+}
+
+sub args ($) {
+    return ( Args => [ $_[0] ] );
+}
+
+sub capture_args ($) {
+    return ( CaptureArgs => [ $_[0] ] );
+}
+
+sub path_part ($) {
+    return ( PathPart => [ $_[0] ] );
+}
+
+sub action ($) {
+    return ( ActionClass => [ $_[0] ] );
+}
+
 # XXX - this should be added to Params::Util
 sub _STRINGLIKE0 ($) {
     return _STRING( $_[0] )

diff --git a/lib/CatalystX/Routes/Role/Class.pm b/lib/CatalystX/Routes/Role/Class.pm
index f80294e..edf4529 100644 (file)
--- a/lib/CatalystX/Routes/Role/Class.pm
+++ b/lib/CatalystX/Routes/Role/Class.pm
@@ -13,4 +13,14 @@ has _routes => (
     },
 );
 
+has _chain_points => (
+    traits  => ['Hash'],
+    isa     => 'HashRef[ArrayRef]',
+    handles => {
+        add_chain_point   => 'set',
+        get_chain_point   => 'get',
+        chain_point_names => 'keys',
+    },
+);
+
 1;

diff --git a/lib/CatalystX/Routes/Role/Controller.pm b/lib/CatalystX/Routes/Role/Controller.pm
index 9a2fab2..6918597 100644 (file)
--- a/lib/CatalystX/Routes/Role/Controller.pm
+++ b/lib/CatalystX/Routes/Role/Controller.pm
@@ -9,36 +9,53 @@ after register_actions => sub {
     my $self = shift;
     my $c    = shift;
 
-    my $class     = $self->catalyst_component_name;
-    my $namespace = $self->action_namespace($c);
-
     for my $route ( $self->meta()->route_names() ) {
         my ( $attrs, $method ) = @{ $self->meta()->get_route($route) };
 
-        for my $key ( keys %{$attrs} ) {
-            my $parse_meth = "_parse_${key}_attr";
+        $self->_add_cx_routes_action( $c, $route, $attrs, $method->body() );
+    }
+
+    for my $chain_point ( $self->meta()->chain_point_names() ) {
+        my ( $attrs, $code )
+            = @{ $self->meta()->get_chain_point($chain_point) };
+
+        $self->_add_cx_routes_action( $c, $chain_point, $attrs, $code );
+    }
+};
 
-            next unless $self->can($parse_meth);
+sub _add_cx_routes_action {
+    my $self  = shift;
+    my $c     = shift;
+    my $name  = shift;
+    my $attrs = shift;
+    my $code  = shift;
 
-            ( undef, my $value )
-                = $self->$parse_meth( $c, $route, $attrs->{$key} );
+    my $class     = $self->catalyst_component_name;
+    my $namespace = $self->action_namespace($c);
 
-            $attrs->{$key} = [$value];
-        }
+    for my $key ( keys %{$attrs} ) {
+        my $parse_meth = "_parse_${key}_attr";
 
-        my $reverse = $namespace ? "${namespace}/$route" : $route;
+        next unless $self->can($parse_meth);
 
-        my $action = $self->create_action(
-            name       => $route,
-            code       => $method->body(),
-            reverse    => $reverse,
-            namespace  => $namespace,
-            class      => $class,
-            attributes => $attrs,
-        );
+        ( undef, my $value )
+            = $self->$parse_meth( $c, $name, $attrs->{$key} );
 
-        $c->dispatcher->register( $c, $action );
+        $attrs->{$key} = [$value];
     }
-};
+
+    my $reverse = $namespace ? "${namespace}/$name" : $name;
+
+    my $action = $self->create_action(
+        name       => $name,
+        code       => $code,
+        reverse    => $reverse,
+        namespace  => $namespace,
+        class      => $class,
+        attributes => $attrs,
+    );
+
+    $c->dispatcher->register( $c, $action );
+}
 
 1;

diff --git a/t/lib/MyApp1/Controller/C1.pm b/t/lib/MyApp1/Controller/C1.pm
index 0646229..2b53f62 100644 (file)
--- a/t/lib/MyApp1/Controller/C1.pm
+++ b/t/lib/MyApp1/Controller/C1.pm
@@ -33,6 +33,23 @@ put 'bar'=> \&_put;
 
 del 'bar'=> \&_del;
 
+chain_point '_set_chain1'
+    => chained '/'
+    => path_part 'chain1'
+    => capture_args 1
+    => sub { $REQ{chain1} = $_[2] };
+
+chain_point '_set_chain2'
+    => chained '_set_chain1'
+    => path_part 'chain2'
+    => capture_args 1
+    => sub { $REQ{chain2} = $_[2] };
+
+get 'baz'
+    => chained '_set_chain2'
+    => args 1
+    => sub { $REQ{baz} = $_[2] };
+
 sub normal : Chained('/') : Args(0) {
     $REQ{normal}++;
 }

diff --git a/t/routes.t b/t/routes.t
index a38a77a..25591bc 100644 (file)
--- a/t/routes.t
+++ b/t/routes.t
@@ -82,6 +82,25 @@ use HTTP::Request::Common qw( GET PUT POST DELETE );
 }
 
 {
+    get('/chain1/42/chain2/84/baz/foo');
+
+    is(
+        $MyApp1::Controller::C1::REQ{chain1}, 42,
+        'chain1 chain point captured the first arg'
+    );
+
+    is(
+        $MyApp1::Controller::C1::REQ{chain2}, 84,
+        'chain2 chain point captured the second arg'
+    );
+
+    is(
+        $MyApp1::Controller::C1::REQ{baz}, 'foo',
+        'baz route captured the third arg'
+    );
+}
+
+{
     get('/normal');
 
     is(