[Catalyst-commits] r9505 - in Catalyst-Runtime/5.70/trunk: lib/Catalyst t t/lib/TestApp/Controller

[ash at dev.catalyst.perl.org]

Author: ash
Date: 2009-03-16 13:56:14 +0000 (Mon, 16 Mar 2009)
New Revision: 9505

Added:
   Catalyst-Runtime/5.70/trunk/t/unit_core_action_chained.t
Modified:
   Catalyst-Runtime/5.70/trunk/lib/Catalyst/Dispatcher.pm
   Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Root.pm
   Catalyst-Runtime/5.70/trunk/t/live_recursion.t
Log:
Add test for looping DispatchType::Chained->list


Modified: Catalyst-Runtime/5.70/trunk/lib/Catalyst/Dispatcher.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/lib/Catalyst/Dispatcher.pm	2009-03-16 10:03:03 UTC (rev 9504)
+++ Catalyst-Runtime/5.70/trunk/lib/Catalyst/Dispatcher.pm	2009-03-16 13:56:14 UTC (rev 9505)
@@ -571,7 +571,12 @@
     $self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
 
     return unless $c->debug;
+    $self->_display_action_tables($c);
+}
 
+sub _display_action_tables {
+    my ($self, $c) = @_;
+
     my $column_width = Catalyst::Utils::term_width() - 20 - 36 - 12;
     my $privates = Text::SimpleTable->new(
         [ 20, 'Private' ], [ 36, 'Class' ], [ $column_width, 'Method' ]
@@ -624,6 +629,20 @@
     return @loaded;
 }
 
+# Dont document this until someone else is happy with beaviour. Ash 2009/03/16
+sub dispatch_type {
+    my ($self, $name) = @_;
+
+    unless ($name =~ s/^\+//) {
+        $name = "Catalyst::DispatchType::" . $name;
+    }
+
+    for (@{ $self->dispatch_types }) {
+        return $_ if ref($_) eq $name;
+    }
+    return undef;
+}
+
 =head1 AUTHORS
 
 Catalyst Contributors, see Catalyst.pm

Modified: Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Root.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Root.pm	2009-03-16 10:03:03 UTC (rev 9504)
+++ Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Root.pm	2009-03-16 13:56:14 UTC (rev 9505)
@@ -20,4 +20,8 @@
     $c->forward('TestApp::View::Dump::Request');
 }
 
+sub chain_to_self : Chained('chain_to_self') PathPart('') CaptureArgs(1) { }
+
+sub chain_recurse_endoint : Chained('chain_to_self') Args(0) { }
+
 1;

Modified: Catalyst-Runtime/5.70/trunk/t/live_recursion.t
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/live_recursion.t	2009-03-16 10:03:03 UTC (rev 9504)
+++ Catalyst-Runtime/5.70/trunk/t/live_recursion.t	2009-03-16 13:56:14 UTC (rev 9505)
@@ -23,3 +23,4 @@
     ok( !$response->is_success, 'Response Not Successful' );
     is( $response->header('X-Catalyst-Error'), 'Deep recursion detected calling "/recursion_test"', 'Deep Recursion Detected' );
 }
+

Added: Catalyst-Runtime/5.70/trunk/t/unit_core_action_chained.t
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/unit_core_action_chained.t	                        (rev 0)
+++ Catalyst-Runtime/5.70/trunk/t/unit_core_action_chained.t	2009-03-16 13:56:14 UTC (rev 9505)
@@ -0,0 +1,26 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 3;
+
+
+use TestApp;
+
+my $dispatch_type = TestApp->dispatcher->dispatch_type('Chained');
+isa_ok($dispatch_type, "Catalyst::DispatchType::Chained", "got dispatch type");
+
+# This test was failing due to recursion/OOM. set up an alarm so things dont
+# runaway
+local $SIG{ALRM} = sub { 
+    ok(0, "Chained->list didn't loop");
+    die "alarm expired - test probably looping";
+};
+alarm 10;
+
+$dispatch_type->list("TestApp");
+ok(1, "Chained->list didn't loop");