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]; |
21 | my $action = "$_[1]"; |
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 | } |
47 | |
48 | |
49 | |
50 | sub auto : Private { |
51 | my ( $self, $c ) = @_; |
52 | ++$c->stash->{auto_count}; |
53 | return 1; |
54 | } |
55 | |
56 | sub default : Private { |
57 | my ( $self, $c ) = @_; |
58 | $c->res->body( sprintf 'default, auto=%d', $c->stash->{auto_count} ); |
59 | } |