[SCM] Debian packaging of libcatalyst-perl branch, master, updated. debian/5.90013-1-7-g51232b2

intrigeri intrigeri at boum.org
Tue Jun 26 04:04:18 UTC 2012


The following commit has been merged in the master branch:
commit 8b7198b2958f8062aaba0e9d5696ef2d4c46a6e8
Author: intrigeri <intrigeri at boum.org>
Date:   Sat Jun 23 21:30:59 2012 +0200

    Imported Upstream version 5.90013

diff --git a/Changes b/Changes
index db4af47..9c87ec1 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,31 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+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:
@@ -19,7 +45,7 @@
     for backward compatibility. This fixes issues with behaviour changes
     in bleadperl. RT#76437
 
-  - Work around Moose bug RT#7536 which breaks
+  - Work around Moose bug RT#75367 which breaks
     Catalyst::Controller::DBIC::API.
 
  Documentation:
diff --git a/MANIFEST b/MANIFEST
index 632e3d7..a334e77 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -99,6 +99,7 @@ t/aggregate/live_component_controller_action_private.t
 t/aggregate/live_component_controller_action_regexp.t
 t/aggregate/live_component_controller_action_streaming.t
 t/aggregate/live_component_controller_action_visit.t
+t/aggregate/live_component_controller_actionroles.t
 t/aggregate/live_component_controller_anon.t
 t/aggregate/live_component_controller_args.t
 t/aggregate/live_component_controller_attributes.t
@@ -162,7 +163,6 @@ t/aggregate/unit_core_script_help.t
 t/aggregate/unit_core_script_run_options.t
 t/aggregate/unit_core_script_server-without_modules.t
 t/aggregate/unit_core_script_server.t
-t/aggregate/unit_core_script_test.t
 t/aggregate/unit_core_scriptrunner.t
 t/aggregate/unit_core_setup.t
 t/aggregate/unit_core_setup_log.t
@@ -201,6 +201,8 @@ t/lib/ACLTestApp.pm
 t/lib/ACLTestApp/Controller/Root.pm
 t/lib/Catalyst/Action/TestAfter.pm
 t/lib/Catalyst/Action/TestBefore.pm
+t/lib/Catalyst/ActionRole/Moo.pm
+t/lib/Catalyst/ActionRole/Zoo.pm
 t/lib/Catalyst/Plugin/Test/Deprecated.pm
 t/lib/Catalyst/Plugin/Test/Errors.pm
 t/lib/Catalyst/Plugin/Test/Headers.pm
@@ -215,6 +217,7 @@ t/lib/ChainedActionsApp/Controller/Root.pm
 t/lib/DeprecatedActionsInAppClassTestApp.pm
 t/lib/DeprecatedTestApp.pm
 t/lib/DeprecatedTestApp/C/Root.pm
+t/lib/Moo.pm
 t/lib/NullPackage.pm
 t/lib/PluginTestApp.pm
 t/lib/PluginTestApp/Controller/Root.pm
@@ -227,10 +230,14 @@ t/lib/ScriptTestApp/TraitFor/Script.pm
 t/lib/ScriptTestApp/TraitFor/Script/Bar.pm
 t/lib/ScriptTestApp/TraitFor/Script/Foo.pm
 t/lib/TestApp.pm
+t/lib/TestApp/Action/TestActionArgsFromConstructor.pm
 t/lib/TestApp/Action/TestBefore.pm
 t/lib/TestApp/Action/TestExtraArgsAction.pm
 t/lib/TestApp/Action/TestMatchCaptures.pm
 t/lib/TestApp/Action/TestMyAction.pm
+t/lib/TestApp/ActionRole/Boo.pm
+t/lib/TestApp/ActionRole/Kooh.pm
+t/lib/TestApp/ActionRole/Moo.pm
 t/lib/TestApp/Controller/Action.pm
 t/lib/TestApp/Controller/Action/Action.pm
 t/lib/TestApp/Controller/Action/Auto.pm
@@ -273,6 +280,7 @@ t/lib/TestApp/Controller/Action/Streaming.pm
 t/lib/TestApp/Controller/Action/TestMultipath.pm
 t/lib/TestApp/Controller/Action/TestRelative.pm
 t/lib/TestApp/Controller/Action/Visit.pm
+t/lib/TestApp/Controller/ActionRoles.pm
 t/lib/TestApp/Controller/Anon.pm
 t/lib/TestApp/Controller/Args.pm
 t/lib/TestApp/Controller/Attributes.pm
@@ -387,6 +395,7 @@ t/psgi_file_testapp_engine_psgi_compat.t
 t/something/Makefile.PL
 t/something/script/foo/bar/for_dist
 t/unit_core_methodattributes_method_metaclass_on_subclasses.t
+t/unit_core_script_test.t
 t/unit_stats.t
 t/unit_utils_load_class.t
 t/unit_utils_subdir.t
diff --git a/META.yml b/META.yml
index e170a5d..0acba21 100644
--- a/META.yml
+++ b/META.yml
@@ -74,5 +74,5 @@ resources:
   homepage: http://dev.catalyst.perl.org/
   license: http://dev.perl.org/licenses/
   repository: git://git.shadowcat.co.uk/catagits/Catalyst-Runtime.git
-version: 5.90012
+version: 5.90013
 x_authority: MSTROUT
diff --git a/Makefile.PL b/Makefile.PL
index 39a964e..4b83510 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -4,16 +4,26 @@ use inc::Module::Install 0.91;
 # 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;
-use Module::Install::Authority;
+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 at cpan.org>';
-authority 'MSTROUT';
+authority('MSTROUT');
 all_from 'lib/Catalyst/Runtime.pm';
 
 requires 'List::MoreUtils';
@@ -68,9 +78,10 @@ test_requires 'Data::Dump';
 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 {
@@ -78,16 +89,18 @@ 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
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 8cd14fe..2b22945 100644
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -100,7 +100,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.90012';
+our $VERSION = '5.90013';
 
 sub import {
     my ( $class, @arguments ) = @_;
diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm
index 1442649..cea7234 100644
--- a/lib/Catalyst/Controller.pm
+++ b/lib/Catalyst/Controller.pm
@@ -1,7 +1,11 @@
 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';
 
@@ -13,28 +17,48 @@ use Catalyst::Utils;
 
 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 => (
@@ -54,6 +78,14 @@ sub BUILD {
 
     # 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 {
@@ -86,10 +118,11 @@ for more info about how Catalyst dispatches to actions.
 
 #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 {
@@ -262,6 +295,20 @@ sub register_action_methods {
     }
 }
 
+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 = @_;
@@ -279,7 +326,21 @@ sub create_action {
     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->{'*'}           || {} },
@@ -289,6 +350,15 @@ sub create_action {
     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 ) = @_;
 
@@ -454,6 +524,32 @@ sub _parse_MyAction_attr {
     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;
@@ -571,6 +667,10 @@ action class to use.
 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
diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm
index 3b7b0c4..5f72fba 100644
--- a/lib/Catalyst/DispatchType/Chained.pm
+++ b/lib/Catalyst/DispatchType/Chained.pm
@@ -253,7 +253,7 @@ sub recurse_match {
 
                 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=> [],
diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm
index 6610358..d2c1c7f 100644
--- a/lib/Catalyst/Request.pm
+++ b/lib/Catalyst/Request.pm
@@ -220,7 +220,7 @@ sub prepare_body_parameters {
     my ( $self ) = @_;
 
     $self->prepare_body if ! $self->_has_body;
-    return unless $self->_body;
+    return {} unless $self->_body;
 
     return $self->_body->param;
 }
diff --git a/lib/Catalyst/Runtime.pm b/lib/Catalyst/Runtime.pm
index 8075a64..cb748fc 100644
--- a/lib/Catalyst/Runtime.pm
+++ b/lib/Catalyst/Runtime.pm
@@ -7,7 +7,7 @@ BEGIN { require 5.008003; }
 
 # Remember to update this in Catalyst as well!
 
-our $VERSION = '5.90012';
+our $VERSION = '5.90013';
 
 =head1 NAME
 
diff --git a/t/aggregate/live_component_controller_action_action.t b/t/aggregate/live_component_controller_action_action.t
index bc2038e..eebfe48 100644
--- a/t/aggregate/live_component_controller_action_action.t
+++ b/t/aggregate/live_component_controller_action_action.t
@@ -193,6 +193,25 @@ sub run_tests {
         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;
diff --git a/t/aggregate/live_component_controller_actionroles.t b/t/aggregate/live_component_controller_actionroles.t
new file mode 100644
index 0000000..0bf1b0c
--- /dev/null
+++ b/t/aggregate/live_component_controller_actionroles.t
@@ -0,0 +1,36 @@
+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;
diff --git a/t/author/http-server.t b/t/author/http-server.t
index 0edba01..2927f18 100644
--- a/t/author/http-server.t
+++ b/t/author/http-server.t
@@ -77,6 +77,15 @@ rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp";
 
 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) = @_;
 
diff --git a/t/lib/Catalyst/Action/TestAfter.pm b/t/lib/Catalyst/Action/TestAfter.pm
index 199ea25..2139a8b 100644
--- a/t/lib/Catalyst/Action/TestAfter.pm
+++ b/t/lib/Catalyst/Action/TestAfter.pm
@@ -3,7 +3,8 @@ package Catalyst::Action::TestAfter;
 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;
diff --git a/t/lib/Catalyst/ActionRole/Moo.pm b/t/lib/Catalyst/ActionRole/Moo.pm
new file mode 100644
index 0000000..3d4aa51
--- /dev/null
+++ b/t/lib/Catalyst/ActionRole/Moo.pm
@@ -0,0 +1,12 @@
+package Catalyst::ActionRole::Moo;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+    my ($self, $controller, $c) = @_;
+    $c->response->body(__PACKAGE__);
+};
+
+1;
diff --git a/t/lib/Catalyst/ActionRole/Zoo.pm b/t/lib/Catalyst/ActionRole/Zoo.pm
new file mode 100644
index 0000000..d4f0c9f
--- /dev/null
+++ b/t/lib/Catalyst/ActionRole/Zoo.pm
@@ -0,0 +1,12 @@
+package Catalyst::ActionRole::Zoo;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+    my ($self, $controller, $c) = @_;
+    $c->response->body(__PACKAGE__);
+};
+
+1;
diff --git a/t/lib/Moo.pm b/t/lib/Moo.pm
new file mode 100644
index 0000000..c28806a
--- /dev/null
+++ b/t/lib/Moo.pm
@@ -0,0 +1,12 @@
+package Moo;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+    my ($self, $controller, $c) = @_;
+    $c->response->body(__PACKAGE__);
+};
+
+1;
diff --git a/t/lib/TestApp.pm b/t/lib/TestApp.pm
index 3bd3763..25203e1 100644
--- a/t/lib/TestApp.pm
+++ b/t/lib/TestApp.pm
@@ -1,5 +1,4 @@
 package TestApp;
-
 use strict;
 use Catalyst qw/
     Test::MangleDollarUnderScore
@@ -42,7 +41,16 @@ has 'my_greeting_obj_lazy' => (
 
 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
diff --git a/t/lib/TestApp/Action/TestExtraArgsAction.pm b/t/lib/TestApp/Action/TestActionArgsFromConstructor.pm
similarity index 71%
copy from t/lib/TestApp/Action/TestExtraArgsAction.pm
copy to t/lib/TestApp/Action/TestActionArgsFromConstructor.pm
index 3cfb38b..67f8a13 100644
--- a/t/lib/TestApp/Action/TestExtraArgsAction.pm
+++ b/t/lib/TestApp/Action/TestActionArgsFromConstructor.pm
@@ -1,11 +1,11 @@
-package TestApp::Action::TestExtraArgsAction;
+package TestApp::Action::TestActionArgsFromConstructor;
 
 use Moose;
 use namespace::autoclean;
 
 extends 'Catalyst::Action';
 
-has [qw/extra_arg another_extra_arg/] => (is => 'ro');
+has [qw/extra_arg another_extra_arg/] => ( is => 'ro' );
 
 after execute => sub {
     my ($self, $controller, $ctx) = @_;
@@ -15,3 +15,4 @@ after execute => sub {
 __PACKAGE__->meta->make_immutable;
 
 1;
+
diff --git a/t/lib/TestApp/ActionRole/Boo.pm b/t/lib/TestApp/ActionRole/Boo.pm
new file mode 100644
index 0000000..f55f9fe
--- /dev/null
+++ b/t/lib/TestApp/ActionRole/Boo.pm
@@ -0,0 +1,16 @@
+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;
diff --git a/t/lib/TestApp/ActionRole/Kooh.pm b/t/lib/TestApp/ActionRole/Kooh.pm
new file mode 100644
index 0000000..fc82bf2
--- /dev/null
+++ b/t/lib/TestApp/ActionRole/Kooh.pm
@@ -0,0 +1,12 @@
+package TestApp::ActionRole::Kooh;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+    my ($self, $controller, $c) = @_;
+    $c->response->header('X-Affe' => 'Tiger');
+};
+
+1;
diff --git a/t/lib/TestApp/ActionRole/Moo.pm b/t/lib/TestApp/ActionRole/Moo.pm
new file mode 100644
index 0000000..d0fd290
--- /dev/null
+++ b/t/lib/TestApp/ActionRole/Moo.pm
@@ -0,0 +1,10 @@
+package TestApp::ActionRole::Moo;
+
+use Moose::Role;
+
+after execute => sub {
+    my ($self, $controller, $c) = @_;
+    $c->response->body(__PACKAGE__);
+};
+
+1;
diff --git a/t/lib/TestApp/Controller/Action/Action.pm b/t/lib/TestApp/Controller/Action/Action.pm
index 6cee5f5..515fb2a 100644
--- a/t/lib/TestApp/Controller/Action/Action.pm
+++ b/t/lib/TestApp/Controller/Action/Action.pm
@@ -58,4 +58,8 @@ sub action_action_eight : Global  {
     $c->forward('TestApp::View::Dump::Action');
 }
 
+sub action_action_nine : Global : ActionClass('~TestActionArgsFromConstructor') {
+    my ( $self, $c ) = @_;
+    $c->forward('TestApp::View::Dump::Request');
+}
 1;
diff --git a/t/lib/TestApp/Controller/ActionRoles.pm b/t/lib/TestApp/Controller/ActionRoles.pm
new file mode 100644
index 0000000..37c24f9
--- /dev/null
+++ b/t/lib/TestApp/Controller/ActionRoles.pm
@@ -0,0 +1,30 @@
+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;
diff --git a/t/lib/TestApp/Controller/BodyParams.pm b/t/lib/TestApp/Controller/BodyParams.pm
index 5732211..ea6bf3a 100644
--- a/t/lib/TestApp/Controller/BodyParams.pm
+++ b/t/lib/TestApp/Controller/BodyParams.pm
@@ -10,4 +10,11 @@ sub default : Private {
     $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;
diff --git a/t/live_catalyst_test.t b/t/live_catalyst_test.t
index e7f8df9..8248527 100644
--- a/t/live_catalyst_test.t
+++ b/t/live_catalyst_test.t
@@ -50,5 +50,10 @@ my $req = '/dump/request';
     is($response, 'that', 'body param overridden');
 }
 
+{
+	my $response = request( POST( '/bodyparams/no_params' ) )->content;
+    is($response, 'HASH', 'empty body param is hashref');
+}
+
 done_testing;
 
diff --git a/t/aggregate/unit_core_script_test.t b/t/unit_core_script_test.t
similarity index 98%
rename from t/aggregate/unit_core_script_test.t
rename to t/unit_core_script_test.t
index e475651..1328bde 100644
--- a/t/aggregate/unit_core_script_test.t
+++ b/t/unit_core_script_test.t
@@ -3,7 +3,7 @@ use warnings;
 
 use Carp qw(croak);
 use FindBin qw/$Bin/;
-use lib "$Bin/../lib";
+use lib "$Bin/lib";
 
 use Test::More;
 use Test::Exception;

-- 
Debian packaging of libcatalyst-perl



More information about the Pkg-perl-cvs-commits mailing list