A hook to attach modifiers to. This method does not do anything except set the
C<setup_finished> accessor.
-Applying method modifiers to the C<setup> method doesn't work, because of quirky thingsdone for plugin setup.
+Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
Example:
$error = qq/Caught exception in $class->$name "$error"/;
}
$c->error($error);
- $c->state(0);
}
+ $c->state(0);
}
return $c->state;
}
init_arg => undef,
);
+# ->config(actions => { '*' => ...
+has _all_actions_attributes => (
+ is => 'ro',
+ isa => 'HashRef',
+ init_arg => undef,
+ lazy => 1,
+ builder => '_build__all_actions_attributes',
+);
+
sub BUILD {
my ($self, $args) = @_;
my $action = delete $args->{action} || {};
my $actions = delete $args->{actions} || {};
my $attr_value = $self->merge_config_hashes($actions, $action);
$self->_controller_actions($attr_value);
-}
+ # trigger lazy builder
+ $self->_all_actions_attributes;
+}
+sub _build__all_actions_attributes {
+ my ($self) = @_;
+ delete $self->_controller_actions->{'*'} || {};
+}
=head1 NAME
sub get_action_methods {
my $self = shift;
my $meta = find_meta($self) || confess("No metaclass setup for $self");
- confess("Metaclass "
- . ref($meta) . " for "
- . $meta->name
- . " cannot support register_actions." )
- unless $meta->can('get_nearest_methods_with_attributes');
+ confess(
+ sprintf "Metaclass %s for %s cannot support register_actions.",
+ ref $meta, $meta->name,
+ ) unless $meta->can('get_nearest_methods_with_attributes');
my @methods = $meta->get_nearest_methods_with_attributes;
# actions specified via config are also action_methods
@methods,
map {
$meta->find_method_by_name($_)
- || confess( 'Action "'
- . $_
- . '" is not available from controller '
- . ( ref $self ) )
- } keys %{ $self->_controller_actions }
+ || confess( sprintf 'Action "%s" is not available from controller %s',
+ $_, ref $self )
+ } keys %{ $self->_controller_actions }
) if ( ref $self );
return uniq @methods;
}
}
}
- #I know that the original behavior was to ignore action if actions was set
- # but i actually think this may be a little more sane? we can always remove
- # the merge behavior quite easily and go back to having actions have
- # presedence over action by modifying the keys. i honestly think this is
- # superior while mantaining really high degree of compat
- my $actions;
+ my ($actions_config, $all_actions_config);
if( ref($self) ) {
- $actions = $self->_controller_actions;
+ $actions_config = $self->_controller_actions;
+ # No, you're not getting actions => { '*' => ... } with actions in MyApp.
+ $all_actions_config = $self->_all_actions_attributes;
} else {
my $cfg = $self->config;
- $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
+ $actions_config = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
+ $all_actions_config = {};
}
- %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
- %raw_attributes,
- (exists $actions->{$name} ? %{$actions->{$name}} : ()));
+ %raw_attributes = (
+ %raw_attributes,
+ exists $actions_config->{$name} ? %{ $actions_config->{$name } } : (),
+ );
+ # Private actions with additional attributes will raise a warning and then
+ # be ignored. Adding '*' arguments to the default _DISPATCH / etc. methods,
+ # which are Private, will prevent those from being registered. They should
+ # probably be turned into :Actions instead, or we might want to otherwise
+ # disambiguate between those built-in internal actions and user-level
+ # Private ones.
+ %raw_attributes = (%{ $all_actions_config }, %raw_attributes)
+ unless $raw_attributes{Private};
my %final_attributes;
my $registered = $self->_registered_dispatch_types;
- #my $priv = 0; #seems to be unused
foreach my $key ( keys %{ $action->attributes } ) {
next if $key eq 'Private';
my $class = "Catalyst::DispatchType::$key";
BEWARE: If you really need to access some environment variable from your Catalyst
application you should use $c->engine->env->{VARNAME} instead of $ENV{VARNAME},
-as in some enviroments the %ENV hash does not contain what you would expect.
+as in some environments the %ENV hash does not contain what you would expect.
=head1 AUTHORS
Returns true or false, indicating whether the connection is secure
(https). Note that the URI scheme (eg., http vs. https) must be determined
-through heuristics, and therefore the reliablity of $req->secure will depend
+through heuristics, and therefore the reliability of $req->secure will depend
on your server configuration. If you are serving secure pages on the standard
SSL port (443) and/or setting the HTTPS environment variable, $req->secure
should be valid.
use File::Copy ();
use IO::File ();
use File::Spec::Unix;
+use namespace::clean -except => 'meta';
has filename => (is => 'rw');
has headers => (is => 'rw');
To be able to generate a linear @ISA, the list of superclasses for each
class must be resolvable using the C3 algorithm. Unfortunately, when
superclasses are being used as mixins (to add functionality used in your class),
-and with multiple inheritence, it is easy to get this wrong.
+and with multiple inheritance, it is easy to get this wrong.
Most common is the case of:
'Content is a serialized Catalyst::Request'
);
}
+
+ {
+ ok( my $response = request('http://localhost/action_action_eight'),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'),
+ 'action_action_eight', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Action',
+ 'Test Class'
+ );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Action' \)$/s,
+ 'Content is a serialized Catalyst::Action'
+ );
+
+ my $action = eval $response->content;
+ is_deeply $action->attributes->{extra_attribute}, [13];
+ is_deeply $action->attributes->{another_extra_attribute}, ['foo'];
+ }
}
done_testing;
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-use Test::More tests => 18*$iters;
+use Test::More tests => 27*$iters;
use Catalyst::Test 'TestApp';
if ( $ENV{CAT_BENCHMARK} ) {
$expected, 'Executed actions' );
is( $response->content, 'default (auto: 1)', 'Content OK' );
}
+
+ # test detach in auto
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Auto::Detach->begin
+ TestApp::Controller::Action::Auto->auto
+ TestApp::Controller::Action::Auto::Detach->auto
+ TestApp::Controller::Root->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/auto/detach'), 'auto with detach' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'detach auto', 'Content OK' );
+ }
+
+ # test detach in auto forward
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Auto::Detach->begin
+ TestApp::Controller::Action::Auto->auto
+ TestApp::Controller::Action::Auto::Detach->auto
+ TestApp::Controller::Action::Auto::Detach->with_forward_detach
+ TestApp::Controller::Root->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/auto/detach?with_forward_detach=1'), 'auto with_forward_detach' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'detach with_forward_detach', 'Content OK' );
+ }
+
+ # test detach in auto forward detach action
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Auto::Detach->begin
+ TestApp::Controller::Action::Auto->auto
+ TestApp::Controller::Action::Auto::Detach->auto
+ TestApp::Controller::Action::Auto::Detach->with_forward_detach
+ TestApp::Controller::Action::Auto::Detach->detach_action
+ TestApp::Controller::Root->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/auto/detach?with_forward_detach=1&detach_to_action=1'), 'auto with_forward_detach to detach_action' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'detach_action', 'Content OK' );
+ }
}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+our $iters;
+
+BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
+
+use Test::More tests => 2*$iters;
+use Catalyst::Test 'TestApp';
+
+if ( $ENV{CAT_BENCHMARK} ) {
+ require Benchmark;
+ Benchmark::timethis( $iters, \&run_tests );
+}
+else {
+ for ( 1 .. $iters ) {
+ run_tests();
+ }
+}
+
+sub run_tests {
+ ok( my $response = request('http://localhost/action/die_in_end'), 'Request' );
+ ok( !$response->is_success, 'generates a 500 error' );
+}
__PACKAGE__->config(
actions => {
- action_action_five => { ActionClass => '+Catalyst::Action::TestBefore' },
+ '*' => { extra_attribute => 13 },
+ action_action_five => { ActionClass => '+Catalyst::Action::TestBefore' },
+ action_action_eight => { another_extra_attribute => 'foo' },
},
action_args => {
'*' => { extra_arg => 42 },
$c->forward('TestApp::View::Dump::Request');
}
+sub action_action_eight : Global {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Action');
+}
+
1;
--- /dev/null
+package TestApp::Controller::Action::Auto::Detach;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub auto : Private {
+ my ( $self, $c ) = @_;
+ $c->res->body( "detach auto" );
+ if ($c->req->param("with_forward_detach")) {
+ $c->forward("with_forward_detach");
+ } else {
+ $c->detach;
+ }
+ return 1;
+}
+
+sub default : Path {
+ my ( $self, $c ) = @_;
+ $c->res->body( 'detach default' );
+}
+
+sub with_forward_detach : Private {
+ my ($self, $c) = @_;
+ $c->res->body( "detach with_forward_detach" );
+ if ($c->req->param("detach_to_action")) {
+ $c->detach("detach_action");
+ } else {
+ $c->detach;
+ }
+}
+
+sub detach_action : Private {
+ my ($self, $c) = @_;
+ $c->res->body("detach_action");
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action::DieInEnd;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub end : Private {
+ my ( $self, $c ) = @_;
+ die "I'm ending with death";
+}
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+1;
--- /dev/null
+package TestApp::View::Dump::Action;
+
+use strict;
+use base qw[TestApp::View::Dump];
+
+sub process {
+ my ( $self, $c ) = @_;
+ return $self->SUPER::process( $c, $c->action );
+}
+
+1;