Commit | Line | Data |
---|---|---|
dd4e6fd2 | 1 | package TestApp; |
2 | ||
3 | use strict; | |
836e1134 | 4 | use Catalyst qw/ |
3d101ef9 | 5 | Test::MangleDollarUnderScore |
836e1134 | 6 | Test::Errors |
7 | Test::Headers | |
8 | Test::Plugin | |
4ca147fa | 9 | Test::Inline |
836e1134 | 10 | +TestApp::Plugin::FullyQualified |
083ee5d9 | 11 | +TestApp::Plugin::AddDispatchTypes |
e5210a95 | 12 | +TestApp::Role |
836e1134 | 13 | /; |
1408d0a4 | 14 | use Catalyst::Utils; |
fdcc808c | 15 | use TestApp::Context; |
dd4e6fd2 | 16 | |
d9d8aa51 | 17 | use Moose; |
18 | use namespace::autoclean; | |
19 | ||
dd4e6fd2 | 20 | our $VERSION = '0.01'; |
21 | ||
fbcc39ad | 22 | TestApp->config( name => 'TestApp', root => '/some/dir' ); |
dd4e6fd2 | 23 | |
fdcc808c | 24 | TestApp->context_class( 'TestApp::Context' ); |
dd4e6fd2 | 25 | TestApp->setup; |
26 | ||
dd4e6fd2 | 27 | sub execute { |
4d989a5d | 28 | my $c = shift; |
29 | my $class = ref( $c->component( $_[0] ) ) || $_[0]; | |
f3414019 | 30 | my $action = $_[1]->reverse; |
dd4e6fd2 | 31 | |
32 | my $method; | |
33 | ||
4d989a5d | 34 | if ( $action =~ /->(\w+)$/ ) { |
35 | $method = $1; | |
dd4e6fd2 | 36 | } |
4d989a5d | 37 | elsif ( $action =~ /\/(\w+)$/ ) { |
38 | $method = $1; | |
dd4e6fd2 | 39 | } |
01ba879f | 40 | elsif ( $action =~ /^(\w+)$/ ) { |
41 | $method = $action; | |
42 | } | |
43 | ||
ba599d1c | 44 | if ( $class && $method && $method !~ /^_/ ) { |
1408d0a4 | 45 | my $executed = sprintf( "%s->%s", $class, $method ); |
fbcc39ad | 46 | my @executed = $c->response->headers->header('X-Catalyst-Executed'); |
47 | push @executed, $executed; | |
48 | $c->response->headers->header( | |
49 | 'X-Catalyst-Executed' => join ', ', | |
50 | @executed | |
51 | ); | |
1408d0a4 | 52 | } |
81f25ce6 | 53 | no warnings 'recursion'; |
dd4e6fd2 | 54 | return $c->SUPER::execute(@_); |
55 | } | |
56 | ||
8153c836 | 57 | # Replace the very large HTML error page with |
58 | # useful info if something crashes during a test | |
59 | sub finalize_error { | |
60 | my $c = shift; | |
61 | ||
dbb2d5cd | 62 | $c->next::method(@_); |
8153c836 | 63 | |
64 | $c->res->status(500); | |
65 | $c->res->body( 'FATAL ERROR: ' . join( ', ', @{ $c->error } ) ); | |
66 | } | |
67 | ||
369c09bc | 68 | { |
69 | no warnings 'redefine'; | |
70 | sub Catalyst::Log::error { } | |
71 | } | |
4ca147fa | 72 | |
73 | # Make sure we can load Inline plugins. | |
74 | ||
75 | package Catalyst::Plugin::Test::Inline; | |
76 | ||
77 | use strict; | |
78 | ||
c057ae86 | 79 | use base qw/Class::Data::Inheritable/; |
4ca147fa | 80 | |
f3414019 | 81 | 1; |