t/lib/TestApp/Context.pm

   1 package TestApp::Context;
   2 use Moose;
   3 extends 'Catalyst::Context';
   4 with 'Catalyst::TraitFor::Context::TestHeaders';
   5
   6 if (eval { Class::MOP::load_class('CatalystX::LeakChecker'); 1 }) {
   7     with 'CatalystX::LeakChecker';
   8
   9     has leaks => (
  10         is      => 'ro',
  11         default => sub { [] },
  12     );
  13 }
  14
  15 sub found_leaks {
  16     my ($ctx, @leaks) = @_;
  17     push @{ $ctx->leaks }, @leaks;
  18 }
  19
  20 sub count_leaks {
  21     my ($ctx) = @_;
  22     return scalar @{ $ctx->leaks };
  23 }
  24
  25 sub execute {
  26     my $c      = shift;
  27     my $class  = ref( $c->component( $_[0] ) ) || $_[0];
  28     my $action = $_[1]->reverse;
  29
  30     my $method;
  31
  32     if ( $action =~ /->(\w+)$/ ) {
  33         $method = $1;
  34     }
  35     elsif ( $action =~ /\/(\w+)$/ ) {
  36         $method = $1;
  37     }
  38     elsif ( $action =~ /^(\w+)$/ ) {
  39         $method = $action;
  40     }
  41
  42     if ( $class && $method && $method !~ /^_/ ) {
  43         my $executed = sprintf( "%s->%s", $class, $method );
  44         my @executed = $c->response->headers->header('X-Catalyst-Executed');
  45         push @executed, $executed;
  46         $c->response->headers->header(
  47             'X-Catalyst-Executed' => join ', ',
  48             @executed
  49         );
  50     }
  51     no warnings 'recursion';
  52     return $c->SUPER::execute(@_);
  53 }
  54
  55 1;
  56