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

[catagits/CatalystX-Routes.git] / lib / CatalystX / Routes.pm

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] )