t/lib/TestAppDoubleAutoBug.pm

   1 use strict;
   2 use warnings;
   3
   4 package TestAppDoubleAutoBug;
   5
   6 use TestLogger;
   7 use Catalyst qw/
   8     Test::Errors
   9     Test::Headers
  10     Test::Plugin
  11 /;
  12
  13 our $VERSION = '0.01';
  14
  15 __PACKAGE__->config( name => 'TestAppDoubleAutoBug', root => '/some/dir' );
  16
  17 __PACKAGE__->log(TestLogger->new);
  18
  19 __PACKAGE__->setup;
  20
  21 sub execute {
  22     my $c      = shift;
  23     my $class  = ref( $c->component( $_[0] ) ) || $_[0];
  24     my $action = $_[1]->reverse();
  25
  26     my $method;
  27
  28     if ( $action =~ /->(\w+)$/ ) {
  29         $method = $1;
  30     }
  31     elsif ( $action =~ /\/(\w+)$/ ) {
  32         $method = $1;
  33     }
  34     elsif ( $action =~ /^(\w+)$/ ) {
  35         $method = $action;
  36     }
  37
  38     if ( $class && $method && $method !~ /^_/ ) {
  39         my $executed = sprintf( "%s->%s", $class, $method );
  40         my @executed = $c->response->headers->header('X-Catalyst-Executed');
  41         push @executed, $executed;
  42         $c->response->headers->header(
  43             'X-Catalyst-Executed' => join ', ',
  44             @executed
  45         );
  46     }
  47
  48     return $c->SUPER::execute(@_);
  49 }
  50
  51 1;
  52