fix plugin loading
[catagits/Catalyst-Runtime.git] / t / lib / TestApp.pm
CommitLineData
dd4e6fd2 1package TestApp;
2
3use strict;
836e1134 4use Catalyst qw/
5 Test::Errors
6 Test::Headers
7 Test::Plugin
8 +TestApp::Plugin::FullyQualified
9/;
1408d0a4 10use Catalyst::Utils;
dd4e6fd2 11
12our $VERSION = '0.01';
13
fbcc39ad 14TestApp->config( name => 'TestApp', root => '/some/dir' );
dd4e6fd2 15
16TestApp->setup;
17
e0e47c71 18sub index : Private {
19 my ( $self, $c ) = @_;
369c09bc 20 $c->res->body('root index');
e0e47c71 21}
22
e5d7f18c 23sub global_action : Private {
2656a6de 24 my ( $self, $c ) = @_;
25 $c->forward('TestApp::View::Dump::Request');
26}
27
dd4e6fd2 28sub execute {
4d989a5d 29 my $c = shift;
30 my $class = ref( $c->component( $_[0] ) ) || $_[0];
fbcc39ad 31 my $action = "$_[1]";
dd4e6fd2 32
33 my $method;
34
4d989a5d 35 if ( $action =~ /->(\w+)$/ ) {
36 $method = $1;
dd4e6fd2 37 }
4d989a5d 38 elsif ( $action =~ /\/(\w+)$/ ) {
39 $method = $1;
dd4e6fd2 40 }
01ba879f 41 elsif ( $action =~ /^(\w+)$/ ) {
42 $method = $action;
43 }
44
ba599d1c 45 if ( $class && $method && $method !~ /^_/ ) {
1408d0a4 46 my $executed = sprintf( "%s->%s", $class, $method );
fbcc39ad 47 my @executed = $c->response->headers->header('X-Catalyst-Executed');
48 push @executed, $executed;
49 $c->response->headers->header(
50 'X-Catalyst-Executed' => join ', ',
51 @executed
52 );
1408d0a4 53 }
fbcc39ad 54
dd4e6fd2 55 return $c->SUPER::execute(@_);
56}
57
8153c836 58# Replace the very large HTML error page with
59# useful info if something crashes during a test
60sub finalize_error {
61 my $c = shift;
62
63 $c->NEXT::finalize_error(@_);
64
65 $c->res->status(500);
66 $c->res->body( 'FATAL ERROR: ' . join( ', ', @{ $c->error } ) );
67}
68
1627551a 69sub class_forward_test_method :Private {
86d993ab 70 my ( $self, $c ) = @_;
71 $c->response->headers->header( 'X-Class-Forward-Test-Method' => 1 );
72}
73
1627551a 74sub loop_test : Local {
75 my ( $self, $c ) = @_;
76
77 for( 1..1001 ) {
78 $c->forward( 'class_forward_test_method' );
79 }
80}
81
82sub recursion_test : Local {
83 my ( $self, $c ) = @_;
84 $c->forward( 'recursion_test' );
85}
86
369c09bc 87{
88 no warnings 'redefine';
89 sub Catalyst::Log::error { }
90}
dd4e6fd2 911;