X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=trunk%2Ft%2Flib%2FTestAppDoubleAutoBug.pm;fp=trunk%2Ft%2Flib%2FTestAppDoubleAutoBug.pm;h=524ed8ba3de67203877b0fc129a6890cdd0b7ef7;hb=e28a6876ad3e11890226e5bab6df4b0725e0981e;hp=0000000000000000000000000000000000000000;hpb=21c94d83082b43028cafcfb18659090b13d832fa;p=catagits%2FCatalyst-Runtime.git diff --git a/trunk/t/lib/TestAppDoubleAutoBug.pm b/trunk/t/lib/TestAppDoubleAutoBug.pm new file mode 100644 index 0000000..524ed8b --- /dev/null +++ b/trunk/t/lib/TestAppDoubleAutoBug.pm @@ -0,0 +1,49 @@ +use strict; +use warnings; + +package TestAppDoubleAutoBug; + +use Catalyst qw/ + Test::Errors + Test::Headers + Test::Plugin +/; + +our $VERSION = '0.01'; + +__PACKAGE__->config( name => 'TestAppDoubleAutoBug', root => '/some/dir' ); + +__PACKAGE__->setup; + +sub execute { + my $c = shift; + my $class = ref( $c->component( $_[0] ) ) || $_[0]; + my $action = $_[1]->reverse(); + + my $method; + + if ( $action =~ /->(\w+)$/ ) { + $method = $1; + } + elsif ( $action =~ /\/(\w+)$/ ) { + $method = $1; + } + elsif ( $action =~ /^(\w+)$/ ) { + $method = $action; + } + + if ( $class && $method && $method !~ /^_/ ) { + my $executed = sprintf( "%s->%s", $class, $method ); + my @executed = $c->response->headers->header('X-Catalyst-Executed'); + push @executed, $executed; + $c->response->headers->header( + 'X-Catalyst-Executed' => join ', ', + @executed + ); + } + + return $c->SUPER::execute(@_); +} + +1; +