t/lib/TestAppDoubleAutoBug.pm

   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]->reverse();
  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 }