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