From: Zbigniew Łukasiak Date: Tue, 17 Nov 2009 15:21:01 +0000 (+0000) Subject: separate context class for TestAppDoubleAutoBug X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=a478032e68d51c107b3132aaddccf4d664637d9f separate context class for TestAppDoubleAutoBug --- diff --git a/t/lib/TestAppDoubleAutoBug.pm b/t/lib/TestAppDoubleAutoBug.pm index cc9e6b8..e2ad872 100644 --- a/t/lib/TestAppDoubleAutoBug.pm +++ b/t/lib/TestAppDoubleAutoBug.pm @@ -9,12 +9,12 @@ use Catalyst qw/ Test::Plugin /; -use TestApp::Context; +use TestAppDoubleAutoBug::Context; our $VERSION = '0.01'; __PACKAGE__->config( name => 'TestAppDoubleAutoBug', root => '/some/dir' ); -__PACKAGE__->context_class( 'TestApp::Context' ); +__PACKAGE__->context_class( 'TestAppDoubleAutoBug::Context' ); __PACKAGE__->setup; 1; diff --git a/t/lib/TestAppDoubleAutoBug/Context.pm b/t/lib/TestAppDoubleAutoBug/Context.pm new file mode 100644 index 0000000..6378a54 --- /dev/null +++ b/t/lib/TestAppDoubleAutoBug/Context.pm @@ -0,0 +1,60 @@ +package TestAppDoubleAutoBug::Context; +use Moose; +extends 'Catalyst::Context'; + +if (eval { Class::MOP::load_class('CatalystX::LeakChecker'); 1 }) { + with 'CatalystX::LeakChecker'; + + has leaks => ( + is => 'ro', + default => sub { [] }, + ); +} + +sub found_leaks { + my ($ctx, @leaks) = @_; + push @{ $ctx->leaks }, @leaks; +} + +sub count_leaks { + my ($ctx) = @_; + return scalar @{ $ctx->leaks }; +} + +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 + ); + } + no warnings 'recursion'; + return $c->SUPER::execute(@_); +} + +after prepare_action => sub{ + my $c = shift; + $c->res->header( 'X-Catalyst-Action' => $c->req->action ); +}; + +1; +