Commit | Line | Data |
7f23827b |
1 | use strict; |
2 | use warnings; |
3 | |
4 | package TestAppDoubleAutoBug; |
5 | |
4fb27043 |
6 | use TestLogger; |
7f23827b |
7 | use Catalyst qw/ |
8 | Test::Errors |
9 | Test::Headers |
10 | Test::Plugin |
11 | /; |
12 | |
13 | our $VERSION = '0.01'; |
14 | |
15 | __PACKAGE__->config( name => 'TestAppDoubleAutoBug', root => '/some/dir' ); |
16 | |
4fb27043 |
17 | __PACKAGE__->log(TestLogger->new); |
18 | |
7f23827b |
19 | __PACKAGE__->setup; |
20 | |
21 | sub execute { |
22 | my $c = shift; |
23 | my $class = ref( $c->component( $_[0] ) ) || $_[0]; |
f3414019 |
24 | my $action = $_[1]->reverse(); |
7f23827b |
25 | |
26 | my $method; |
27 | |
28 | if ( $action =~ /->(\w+)$/ ) { |
29 | $method = $1; |
30 | } |
31 | elsif ( $action =~ /\/(\w+)$/ ) { |
32 | $method = $1; |
33 | } |
34 | elsif ( $action =~ /^(\w+)$/ ) { |
35 | $method = $action; |
36 | } |
37 | |
38 | if ( $class && $method && $method !~ /^_/ ) { |
39 | my $executed = sprintf( "%s->%s", $class, $method ); |
40 | my @executed = $c->response->headers->header('X-Catalyst-Executed'); |
41 | push @executed, $executed; |
42 | $c->response->headers->header( |
43 | 'X-Catalyst-Executed' => join ', ', |
44 | @executed |
45 | ); |
46 | } |
47 | |
48 | return $c->SUPER::execute(@_); |
49 | } |
f4c8c6d4 |
50 | |
51 | 1; |
52 | |