# This file documents the revision history for Perl extension Catalyst.
+5.90014 - 2012-06-26 10:00:00
+
+ - Fix calling finalize_headers before writing body when using $c->write /
+ $c->res->write (fixes RT#76179).
+
+5.90013 - 2012-06-21 10:40:00
+
+ - Release previous TRIAL as stable.
+ - We failed to note in the previous changelog that the Makefile.PL has been
+ improved to make it easier for authors to bootstrap a developer install
+ of Catalyst.
+
+5.90013 - TRIAL 2012-06-07 20:21:00
+
+ New features:
+ - Merge Catalyst::Controller::ActionRole into Catalyst::Controller.
+
+ Bug fixes:
+ - Fix warnings in some matching cases for Action methods with
+ Args(), when using Catalyst::DispatchType::Chained
+
+ - Fix request body parameters to not be undef if no parameters
+ are supplied.
+
+ - Fix action_args config so that it can be specified in the
+ top level config.
+
+ - Fix t/author/http-server.t on Win32
+
+ - Fix use of Test::Aggregate to make tests faster.
+
+5.90012 - 2012-05-16 09:59:00
+
+ Distribution META.yml changes:
+ - author key is now correct, rather than what Module::Install
+ mis-parses from the documentation.
+ - x_authority key added.
+
Bug fixes:
- Fix request body parameters being multiply rebuilt. Fixes both
RT#75607 and CatalystX::DebugFilter
+ - Make plugin de-duplication work as intended originally, as whilst
+ duplicate plugins are totally unwise, the C3 error given to the user
+ is less than helpful.
+
+ - Remove dependence on obscure behaviour in B::Hooks::EndOfScope
+ for backward compatibility. This fixes issues with behaviour changes
+ in bleadperl. RT#76437
+
+ - Work around Moose bug RT#75367 which breaks
+ Catalyst::Controller::DBIC::API.
+
Documentation:
- Fix documentation in Catalyst::Component to show attributes and
calling readers, rather than accessing elements in the $self->{} hash
directly.
- Add note in Catalyst::Component to strongly disrecommend $self->config
+ - Fix vague 'checkout' wording in Catalyst::Utils. RT#77000
+ - Fix documentation for the 'secure' method in Catalyst:Request. RT#76710
5.90011 - 2012-03-08 16:43:00
# Ensure that these get used - yes, M::I loads them for us, but if you're
# in author mode and don't have them installed, then the error is tres
# cryptic.
-use Module::Install::AuthorRequires;
-use Module::Install::CheckConflicts;
-use Module::Install::AuthorTests;
+if ($Module::Install::AUTHOR) { # We could just use them, but telling
+ my @fail; # people the set of things they need nicer
+ foreach my $module (qw/
+ Module::Install::AuthorRequires
+ Module::Install::CheckConflicts
+ Module::Install::AuthorTests
+ Module::Install::Authority
+ /) {
+ push(@fail, $module)
+ unless eval qq{require $module; 1;};
+ }
+ die("Module::Install extensions failed, not installed? \n"
+ . join("\n", map { " $_" } @fail) . "\n") if @fail;
+}
perl_version '5.008003';
name 'Catalyst-Runtime';
+author 'Sebastian Riedel <sri@cpan.org>';
+authority('MSTROUT');
all_from 'lib/Catalyst/Runtime.pm';
requires 'Bread::Board';
requires 'List::MoreUtils';
requires 'namespace::autoclean' => '0.09';
-requires 'namespace::clean' => '0.13';
-requires 'B::Hooks::EndOfScope' => '0.10';
+requires 'namespace::clean' => '0.23';
requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903';
requires 'Class::Load' => '0.12';
requires 'Class::MOP' => '0.95';
test_requires 'HTTP::Request::Common';
# aggregate tests if AGGREGATE_TESTS is set and a recent Test::Aggregate and a Test::Simple it works with is available
+my @author_requires;
if ($ENV{AGGREGATE_TESTS} && can_use('Test::Simple', '0.88') && can_use('Test::Aggregate', '0.364')) {
- author_requires('Test::Aggregate', '0.364');
- author_requires('Test::Simple', '0.88');
+ push(@author_requires, 'Test::Aggregate', '0.364');
+ push(@author_requires, 'Test::Simple', '0.88');
open my $fh, '>', '.aggregating';
}
else {
tests 't/*.t t/aggregate/*.t';
}
-author_requires 'CatalystX::LeakChecker', '0.05';
-author_requires 'File::Copy::Recursive'; # For http server test
-author_requires 'Catalyst::Devel', '1.0'; # For http server test
-author_requires 'Catalyst::Engine::PSGI';
-author_requires 'Test::Without::Module';
-author_requires 'Starman';
-author_requires 'MooseX::Daemonize';
-
-author_tests 't/author';
-author_requires(map {; $_ => 0 } qw(
+push(@author_requires, 'CatalystX::LeakChecker', '0.05');
+push(@author_requires, 'Catalyst::Devel', '1.0'); # For http server test
+
+author_tests('t/author');
+author_requires(
+ @author_requires,
+ map {; $_ => 0 } qw(
+ File::Copy::Recursive
+ Catalyst::Engine::PSGI
+ Test::Without::Module
+ Starman
+ MooseX::Daemonize
Test::NoTabs
Test::Pod
Test::Pod::Coverage
use Moose::Meta::Class ();
extends 'Catalyst::Component';
use Moose::Util qw/find_meta/;
-use B::Hooks::EndOfScope ();
+use namespace::clean -except => 'meta';
use Catalyst::Exception;
use Catalyst::Exception::Detach;
use Catalyst::Exception::Go;
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90011';
+our $VERSION = '5.90014';
sub import {
my ( $class, @arguments ) = @_;
$class->log->info("$name powered by Catalyst $Catalyst::VERSION");
}
- # Make sure that the application class becomes immutable at this point,
- B::Hooks::EndOfScope::on_scope_end {
- return if $@;
- my $meta = Class::MOP::get_metaclass_by_name($class);
- if (
- $meta->is_immutable
- && ! { $meta->immutable_options }->{replace_constructor}
- && (
- $class->isa('Class::Accessor::Fast')
- || $class->isa('Class::Accessor')
- )
- ) {
- warn "You made your application class ($class) immutable, "
- . "but did not inline the\nconstructor. "
- . "This will break catalyst, as your app \@ISA "
- . "Class::Accessor(::Fast)?\nPlease pass "
- . "(replace_constructor => 1)\nwhen making your class immutable.\n";
- }
- $meta->make_immutable(
- replace_constructor => 1,
- ) unless $meta->is_immutable;
- };
-
if ($class->config->{case_sensitive}) {
$class->log->warn($class . "->config->{case_sensitive} is set.");
$class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
my $uploadtmp = $class->config->{uploadtmp};
my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
+ $c->response->_context($c);
+
#surely this is not the most efficient way to do things...
$c->stats($class->stats_class->new)->enable($c->use_stats);
if ( $c->debug || $c->config->{enable_catalyst_header} ) {
sub run {
my $app = shift;
+ $app->_make_immutable_if_needed;
$app->engine_loader->needs_psgi_engine_compat_hack ?
$app->engine->run($app, @_) :
$app->engine->run( $app, $app->_finalized_psgi_app, @_ );
}
+sub _make_immutable_if_needed {
+ my $class = shift;
+ my $meta = Class::MOP::get_metaclass_by_name($class);
+ my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
+ if (
+ $meta->is_immutable
+ && ! { $meta->immutable_options }->{replace_constructor}
+ && $isa_ca
+ ) {
+ warn("You made your application class ($class) immutable, "
+ . "but did not inline the\nconstructor. "
+ . "This will break catalyst, as your app \@ISA "
+ . "Class::Accessor(::Fast)?\nPlease pass "
+ . "(replace_constructor => 1)\nwhen making your class immutable.\n");
+ }
+ unless ($meta->is_immutable) {
+ # XXX - FIXME warning here as you should make your app immutable yourself.
+ $meta->make_immutable(
+ replace_constructor => 1,
+ );
+ }
+}
+
=head2 $c->set_action( $action, $code, $namespace, $attrs )
Sets an action in a given namespace.
Class::MOP::load_class( $plugin );
$class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
if $plugin->isa( 'Catalyst::Component' );
- $proto->_plugins->{$plugin} = 1;
- unless ($instant) {
+ my $plugin_meta = Moose::Meta::Class->create($plugin);
+ if (!$plugin_meta->has_method('new')
+ && ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) {
+ $plugin_meta->add_method('new', Moose::Object->meta->get_method('new'))
+ }
+ if (!$instant && !$proto->_plugins->{$plugin}) {
my $meta = Class::MOP::get_metaclass_by_name($class);
$meta->superclasses($plugin, $meta->superclasses);
}
+ $proto->_plugins->{$plugin} = 1;
return $class;
}
package Catalyst::Controller;
use Moose;
+use Class::MOP;
+use Class::Load ':all';
+use String::RewritePrefix;
use Moose::Util qw/find_meta/;
+use List::Util qw/first/;
use List::MoreUtils qw/uniq/;
use namespace::clean -except => 'meta';
with 'Catalyst::Component::ApplicationAttribute';
-has path_prefix =>
- (
- is => 'rw',
- isa => 'Str',
- init_arg => 'path',
- predicate => 'has_path_prefix',
- );
+has path_prefix => (
+ is => 'rw',
+ isa => 'Str',
+ init_arg => 'path',
+ predicate => 'has_path_prefix',
+);
-has action_namespace =>
- (
- is => 'rw',
- isa => 'Str',
- init_arg => 'namespace',
- predicate => 'has_action_namespace',
- );
+has action_namespace => (
+ is => 'rw',
+ isa => 'Str',
+ init_arg => 'namespace',
+ predicate => 'has_action_namespace',
+);
-has actions =>
- (
- accessor => '_controller_actions',
- isa => 'HashRef',
- init_arg => undef,
- );
+has actions => (
+ accessor => '_controller_actions',
+ isa => 'HashRef',
+ init_arg => undef,
+);
+
+has _action_role_args => (
+ traits => [qw(Array)],
+ isa => 'ArrayRef[Str]',
+ init_arg => 'action_roles',
+ default => sub { [] },
+ handles => {
+ _action_role_args => 'elements',
+ },
+);
+
+has _action_roles => (
+ traits => [qw(Array)],
+ isa => 'ArrayRef[RoleName]',
+ init_arg => undef,
+ lazy => 1,
+ builder => '_build__action_roles',
+ handles => {
+ _action_roles => 'elements',
+ },
+);
+
+has action_args => (is => 'ro');
# ->config(actions => { '*' => ...
has _all_actions_attributes => (
# trigger lazy builder
$self->_all_actions_attributes;
+ $self->_action_roles;
+}
+
+sub _build__action_roles {
+ my $self = shift;
+ my @roles = $self->_expand_role_shortname($self->_action_role_args);
+ load_class($_) for @roles;
+ return \@roles;
}
sub _build__all_actions_attributes {
#I think both of these could be attributes. doesn't really seem like they need
#to ble class data. i think that attributes +default would work just fine
-__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
+__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class _action_role_prefix/;
__PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
__PACKAGE__->_action_class('Catalyst::Action');
+__PACKAGE__->_action_role_prefix([ 'Catalyst::ActionRole::' ]);
sub _DISPATCH : Private {
}
}
+sub _apply_action_class_roles {
+ my ($self, $class, @roles) = @_;
+
+ load_class($_) for @roles;
+ my $meta = Moose::Meta::Class->initialize($class)->create_anon_class(
+ superclasses => [$class],
+ roles => \@roles,
+ cache => 1,
+ );
+ $meta->add_method(meta => sub { $meta });
+
+ return $meta->name;
+}
+
sub action_class {
my $self = shift;
my %args = @_;
my %args = @_;
my $class = $self->action_class(%args);
- my $action_args = $self->config->{action_args};
+
+ load_class($class);
+ Moose->init_meta(for_class => $class)
+ unless Class::MOP::does_metaclass_exist($class);
+
+ unless ($args{name} =~ /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/) {
+ my @roles = $self->gather_action_roles(%args);
+ $class = $self->_apply_action_class_roles($class, @roles) if @roles;
+ }
+
+ my $action_args = (
+ ref($self)
+ ? $self->action_args
+ : $self->config->{action_args}
+ );
my %extra_args = (
%{ $action_args->{'*'} || {} },
return $class->new({ %extra_args, %args });
}
+sub gather_action_roles {
+ my ($self, %args) = @_;
+
+ return (
+ (blessed $self ? $self->_action_roles : ()),
+ @{ $args{attributes}->{Does} || [] },
+ );
+}
+
sub _parse_attrs {
my ( $self, $c, $name, @attrs ) = @_;
return ( 'ActionClass', $value );
}
+sub _parse_Does_attr {
+ my ($self, $app, $name, $value) = @_;
+ return Does => $self->_expand_role_shortname($value);
+}
+
+sub _expand_role_shortname {
+ my ($self, @shortnames) = @_;
+ my $app = $self->_application;
+
+ my $prefix = $self->can('_action_role_prefix') ? $self->_action_role_prefix : ['Catalyst::ActionRole::'];
+ my @prefixes = (qq{${app}::ActionRole::}, @$prefix);
+
+ return String::RewritePrefix->rewrite(
+ { '' => sub {
+ my $loaded = load_first_existing_class(
+ map { "$_$_[0]" } @prefixes
+ );
+ return first { $loaded =~ /^$_/ }
+ sort { length $b <=> length $a } @prefixes;
+ },
+ '~' => $prefixes[0],
+ '+' => '' },
+ @shortnames,
+ );
+}
+
__PACKAGE__->meta->make_immutable;
1;
Called with a hash of data to be use for construction of a new
Catalyst::Action (or appropriate sub/alternative class) object.
+=head2 $self->gather_action_roles(\%action_args)
+
+Gathers the list of roles to apply to an action with the given %action_args.
+
=head2 $self->_application
=head2 $self->_app
if (!$best_action ||
@parts < @{$best_action->{parts}} ||
- (!@parts && $args_attr eq 0)){
+ (!@parts && defined($args_attr) && $args_attr eq "0")){
$best_action = {
actions => [ $action ],
captures=> [],
$title = $name = "$name on Catalyst $Catalyst::VERSION";
$name = "<h1>$name</h1>";
+ # Don't show context in the dump
+ $c->res->_clear_context;
+
# Don't show body parser in the dump
$c->req->_clear_body;
sub snippets { shift->captures(@_) }
has _read_position => (
- init_arg => undef,
+ # FIXME: work around Moose bug RT#75367
+ # init_arg => undef,
is => 'ro',
writer => '_set_read_position',
default => 0,
);
has _read_length => (
- init_arg => undef,
+ # FIXME: work around Moose bug RT#75367
+ # init_arg => undef,
is => 'ro',
default => sub {
my $self = shift;
my ( $self ) = @_;
$self->prepare_body if ! $self->_has_body;
- return unless $self->_body;
+ return {} unless $self->_body;
return $self->_body->param;
}
Returns true or false, indicating whether the connection is secure
(https). Note that the URI scheme (e.g., http vs. https) must be determined
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.
+on your server configuration. If you are setting the HTTPS environment variable,
+$req->secure should be valid.
=head2 $req->captures
required => 1,
lazy => 1,
);
+has _context => (
+ is => 'rw',
+ weak_ref => 1,
+ clearer => '_clear_context',
+);
sub output { shift->body(@_) }
my ( $self, $buffer ) = @_;
# Finalize headers if someone manually writes output
- $self->finalize_headers;
+ $self->_context->finalize_headers;
$buffer = q[] unless defined $buffer;
# Remember to update this in Catalyst as well!
-our $VERSION = '5.90011';
+our $VERSION = '5.90014';
=head1 NAME
=head2 dist_indicator_file_list
Returns a list of files which can be tested to check if you're inside
-a checkout
+a CPAN distribution which is not yet installed.
+
+These are:
+
+=over
+
+=item Makefile.PL
+
+=item Build.PL
+
+=item dist.ini
+
+=back
=cut
is_deeply $action->attributes->{extra_attribute}, [13];
is_deeply $action->attributes->{another_extra_attribute}, ['foo'];
}
+ {
+ ok( my $response = request('http://localhost/action_action_nine'),
+ '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_nine', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Action',
+ 'Test Class'
+ );
+ is( $response->header('X-TestExtraArgsAction'), '42,13', 'Extra args get passed to action constructor' );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
}
done_testing;
ok( my $response = request('http://localhost/streaming'), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' );
SKIP:
{
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
is( $response->content_length, -s $file, 'Response Content-Length' );
+ is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' );
is( $response->content, $buffer, 'Content is read from filehandle' );
ok( $response = request('http://localhost/action/streaming/body_glob'),
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
is( $response->content_length, -s $file, 'Response Content-Length' );
+ is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' );
is( $response->content, $buffer, 'Content is read from filehandle' );
}
ok( my $response = request('http://localhost/action/streaming/body_large'), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' );
is( $response->content_length, $size, 'Response Content-Length' );
is( $response->content, "\0" x $size, 'Content is read from filehandle' );
}
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Catalyst::Test 'TestApp';
+
+my %roles = (
+ foo => 'TestApp::ActionRole::Moo',
+ bar => 'TestApp::ActionRole::Moo',
+ baz => 'Moo',
+ quux => 'Catalyst::ActionRole::Zoo',
+);
+
+while (my ($path, $role) = each %roles) {
+ my $resp = request("/actionroles/${path}");
+ ok($resp->is_success);
+ is($resp->content, $role);
+ is($resp->header('X-Affe'), 'Tiger');
+}
+
+{
+ my $resp = request("/actionroles/corge");
+ ok($resp->is_success);
+ is($resp->content, 'TestApp::ActionRole::Moo');
+ is($resp->header('X-Affe'), 'Tiger');
+ is($resp->header('X-Action-After'), 'moo');
+}
+{
+ my $resp = request("/actionroles/frew");
+ ok($resp->is_success);
+ is($resp->content, 'hello', 'action_args are honored with ActionRoles');
+ }
+done_testing;
is( $return, 0, 'live tests' );
+# kill 'INT' doesn't exist in Windows, so to prevent child hanging,
+# this process will need to commit seppuku to clean up the children.
+if ($^O eq 'MSWin32') {
+ # Furthermore, it needs to do it 'politely' so that TAP doesn't
+ # smell anything 'dubious'.
+ require Win32::Process; # core in all versions of Win32 Perl
+ Win32::Process::KillProcess($$, $return);
+}
+
sub wait_port_timeout {
my ($port, $timeout) = @_;
use strict;
use warnings;
-use base qw/Catalyst::Action/;
+use base qw/Catalyst::Action/; # N.B. Keep as a non-moose class, this also
+ # tests metaclass initialization works as expected
sub execute {
my $self = shift;
--- /dev/null
+package Catalyst::ActionRole::Moo;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->body(__PACKAGE__);
+};
+
+1;
--- /dev/null
+package Catalyst::ActionRole::Zoo;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->body(__PACKAGE__);
+};
+
+1;
--- /dev/null
+package Moo;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->body(__PACKAGE__);
+};
+
+1;
our $VERSION = '0.01';
-TestApp->config( name => 'TestApp', root => '/some/dir', use_request_uri_for_path => 1 );
+TestApp->config(
+ name => 'TestApp',
+ root => '/some/dir',
+ use_request_uri_for_path => 1,
+ 'Controller::Action::Action' => {
+ action_args => {
+ action_action_nine => { another_extra_arg => 13 }
+ }
+ }
+);
# Test bug found when re-adjusting the metaclass compat code in Moose
# in 292360. Test added to Moose in 4b760d6, but leave this attribute
sub Catalyst::Log::error { }
}
+<<<<<<< HEAD
# Make sure we can load Inline plugins.
+=======
+# Pretend to be Plugin::Session and hook finalize_headers to send a header
+
+sub finalize_headers {
+ my $c = shift;
+
+ $c->res->header('X-Test-Header', 'valid');
+
+ return $c->maybe::next::method(@_);
+}
+
+# Make sure we can load Inline plugins.
+>>>>>>> origin/master
package Catalyst::Plugin::Test::Inline;
--- /dev/null
+package TestApp::Action::TestActionArgsFromConstructor;
+
+use Moose;
+use namespace::autoclean;
+
+extends 'Catalyst::Action';
+
+has [qw/extra_arg another_extra_arg/] => ( is => 'ro' );
+
+after execute => sub {
+ my ($self, $controller, $ctx) = @_;
+ $ctx->response->header('X-TestExtraArgsAction' => join q{,} => $self->extra_arg, $self->another_extra_arg);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
--- /dev/null
+package TestApp::ActionRole::Boo;
+
+use Moose::Role;
+
+has boo => (
+ is => 'ro',
+ required => 1,
+);
+
+around execute => sub {
+ my ($orig, $self, $controller, $ctx, @rest) = @_;
+ $ctx->stash(action_boo => $self->boo);
+ return $self->$orig($controller, $ctx, @rest);
+};
+
+1;
--- /dev/null
+package TestApp::ActionRole::Kooh;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->header('X-Affe' => 'Tiger');
+};
+
+1;
--- /dev/null
+package TestApp::ActionRole::Moo;
+
+use Moose::Role;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->body(__PACKAGE__);
+};
+
+1;
$c->forward('TestApp::View::Dump::Action');
}
+sub action_action_nine : Global : ActionClass('~TestActionArgsFromConstructor') {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
1;
--- /dev/null
+package TestApp::Controller::ActionRoles;
+
+use Moose;
+
+BEGIN { extends 'Catalyst::Controller' }
+
+__PACKAGE__->config(
+ action_roles => ['~Kooh'],
+ action_args => {
+ frew => { boo => 'hello' },
+ },
+);
+
+sub foo : Local Does('Moo') {}
+sub bar : Local Does('~Moo') {}
+sub baz : Local Does('+Moo') {}
+sub quux : Local Does('Zoo') {}
+
+sub corge : Local Does('Moo') ActionClass('TestAfter') {
+ my ($self, $ctx) = @_;
+ $ctx->stash(after_message => 'moo');
+}
+
+sub frew : Local Does('Boo') {
+ my ($self, $ctx) = @_;
+ my $boo = $ctx->stash->{action_boo};
+ $ctx->response->body($boo);
+}
+
+1;
$c->res->status(200);
}
+sub no_params : Local {
+ my ( $self, $c ) = @_;
+ my $params = $c->req->body_parameters;
+ $c->res->output(ref $params);
+ $c->res->status(200);
+}
+
1;
package TestAppBadlyImmutable;
use Catalyst qw/+TestPluginWithConstructor/;
+
+use base qw/Class::Accessor Catalyst/;
+
use Test::More;
__PACKAGE__->setup;
-ok !__PACKAGE__->meta->is_immutable, 'Am not already immutable';
__PACKAGE__->meta->make_immutable( inline_constructor => 0 );
ok __PACKAGE__->meta->is_immutable, 'Am now immutable';
is($response, 'that', 'body param overridden');
}
+{
+ my $response = request( POST( '/bodyparams/no_params' ) )->content;
+ is($response, 'HASH', 'empty body param is hashref');
+}
+
done_testing;
# that plugins don't get it wrong for us.
# Also tests method modifiers and etc in MyApp.pm still work as expected.
-use Test::More tests => 8;
+use Test::More;
use Test::Exception;
use Moose::Util qw/find_meta/;
use FindBin;
use lib "$FindBin::Bin/lib";
use Catalyst::Test qw/TestAppPluginWithConstructor/;
+TestAppPluginWithConstructor->_make_immutable_if_needed;
ok find_meta('TestAppPluginWithConstructor')->is_immutable,
'Am immutable after use';
is $TestAppPluginWithConstructor::MODIFIER_FIRED, 1, 'Before modifier was fired correctly.';
my $warning;
-local $SIG{__WARN__} = sub { $warning = $_[0] };
-eval "use TestAppBadlyImmutable;";
+eval "use TestAppBadlyImmutable";
+local $SIG{__WARN__} = sub { $warning .= $_[0] };
+
+TestAppBadlyImmutable->_make_immutable_if_needed;
+
like $warning, qr/\QYou made your application class (TestAppBadlyImmutable) immutable/,
'An application class that is already immutable but does not inline the constructor warns at ->setup';
+done_testing;
+
use Carp qw(croak);
use FindBin qw/$Bin/;
-use lib "$Bin/../lib";
+use lib "$Bin/lib";
use Test::More;
use Test::Exception;
projects / catagits/Catalyst-Runtime.git / commitdiff