--- /dev/null
+use MooseX::Declare;
+use Class::MOP;
+
+role CatalystX::Declarative::Controller::DetermineActionClass
+ with CatalystX::Declarative::Controller::QualifyClassNames {
+
+ around create_action (%args) {
+
+ my ($action_class) = @{ $args{attributes}{CatalystX_Declarative_ActionClass} || [] };
+ $action_class ||= 'Catalyst::Action';
+
+ my $fq_class = $self->_qualify_class_name('Action', $action_class);
+ Class::MOP::load_class($fq_class);
+
+ $args{attributes}{ActionClass} ||= [$fq_class];
+
+ return $self->$orig(%args);
+ }
+}
+
--- /dev/null
+use MooseX::Declare;
+
+use Class::MOP;
+use Class::Inspector;
+
+role CatalystX::Declarative::Controller::QualifyClassNames {
+
+ use Carp qw( croak );
+
+ method _qualify_class_name (Str $type, Str $name) {
+
+ my $app = ref($self->_application) || $self->_application;
+
+ my @possibilities = (
+ join('::', $app, $type, $name),
+ join('::', 'Catalyst', $type, $name),
+ $name,
+ );
+
+ for my $class (@possibilities) {
+
+ return $class
+ if Class::MOP::is_class_loaded($class);
+
+ return $class
+ if Class::Inspector->installed($class);
+ }
+
+ croak sprintf q(Unable to locate %s %s named '%s', tried: %s),
+ ($type =~ /^[aeiuo]/i ? 'an' : 'a'),
+ $type,
+ $name,
+ join(', ', @possibilities),
+ ;
+ }
+}
--- /dev/null
+use MooseX::Declare;
+use Class::MOP;
+
+role CatalystX::Declarative::Controller::RegisterActionRoles
+ with CatalystX::Declarative::Controller::QualifyClassNames {
+
+ around create_action (%args) {
+
+ my @action_roles = @{ delete($args{attributes}{CatalystX_Declarative_ActionRoles}) || [] };
+
+ my $action = $self->$orig(%args);
+
+ for my $role (@action_roles) {
+ my $fq_role = $self->_qualify_class_name(ActionRole => $role);
+
+ Class::MOP::load_class($role);
+ $role->meta->apply($action);
+ }
+
+ return $action;
+ }
+}
+
with MooseX::Declare::Syntax::KeywordHandling {
- use Carp qw( croak );
- use Perl6::Junction qw( any );
- use Data::Dump qw( pp );
+ use Carp qw( croak );
+ use Perl6::Junction qw( any );
+ use Data::Dump qw( pp );
+ use MooseX::Types::Util qw( has_available_type_export );
+ use Class::Inspector;
+ use Class::MOP;
+
use constant STOP_PARSING => '__MXDECLARE_STOP_PARSING__';
use constant UNDER_VAR => '$CatalystX::Declarative::SCOPE::UNDER';
name => $name,
);
+ AttributeRole->meta->apply($method);
+
$_->($method)
for @populators;
);
}
- AttributeRole->meta->apply($method);
-
my @attributes = map {
join('',
$_,
- sprintf('(%s)', $attributes{ $_ }),
+ sprintf('(%s)',
+ ref($attributes{ $_ }) eq 'ARRAY'
+ ? join(' ', @{ $attributes{ $_ } })
+ : $attributes{ $_ }
+ ),
);
} keys %attributes;
});
}
+ method _handle_with_option (Object $ctx, HashRef $attrs) {
+
+ my $role = $ctx->strip_name
+ or croak "Expected bareword role specification for action after with";
+
+ # we need to fish for aliases here since we are still unclean
+ if (defined(my $alias = $self->_check_for_available_import($ctx, $role))) {
+ $role = $alias;
+ }
+
+ push @{ $attrs->{CatalystX_Declarative_ActionRoles} ||= [] }, $role;
+
+ return;
+ }
+
+ method _handle_isa_option (Object $ctx, HashRef $attrs) {
+
+ my $class = $ctx->strip_name
+ or croak "Expected bareword action class specification for action after isa";
+
+ if (defined(my $alias = $self->_check_for_available_import($ctx, $class))) {
+ $class = $alias;
+ }
+
+ $attrs->{CatalystX_Declarative_ActionClass} = $class;
+
+ return;
+ }
+
+ method _check_for_available_import (Object $ctx, Str $name) {
+
+ if (my $code = $ctx->get_curstash_name->can($name)) {
+ return $code->();
+ }
+
+ return undef;
+ }
+
method _handle_action_option (Object $ctx, HashRef $attrs) {
# action name
if ($ctx->peek_next_char eq '{' and $self->identifier eq 'under') {
$ctx->inject_if_block(
- sprintf 'local %s; BEGIN { %s = qq(%s) };',
+ sprintf '%s; local %s; BEGIN { %s = qq(%s) };',
+ $ctx->scope_injector_call,
UNDER_VAR,
UNDER_VAR,
$target,
use MooseX::MethodAttributes ();
use aliased 'CatalystX::Declarative::Keyword::Action', 'ActionKeyword';
+ use aliased 'CatalystX::Declarative::Controller::RegisterActionRoles';
+ use aliased 'CatalystX::Declarative::Controller::DetermineActionClass';
before add_namespace_customizations (Object $ctx, Str $package) {
MooseX::MethodAttributes->init_meta(for_class => $package);
- $ctx->add_preamble_code_parts('use CLASS');
+ $ctx->add_preamble_code_parts(
+ 'use CLASS',
+ sprintf('with qw( %s )', join ' ',
+ RegisterActionRoles,
+ DetermineActionClass,
+ ),
+ );
}
method default_superclasses { 'Catalyst::Controller' }
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More tests => 8;
+use Test::More tests => 12;
use Catalyst::Test 'TestApp';
# simple stuff
# nested under
is get('/foo/lower/down/the/stream'), 'foo/stream', 'nested under blocks';
+
+# action roles
+do {
+ local $ENV{TESTAPP_ACTIONROLE} = 1;
+ is get('/foo/with_role'), 'YES', 'fully named action role works';
+};
+do {
+ local $ENV{TESTAPP_ACTIONROLE} = 0;
+ is get('/foo/with_role'), 'NO', 'aliased action role works';
+};
+
+# action class
+is get('/foo/book/Whatever/view/xml'), 'Page 1 of "Whatever" as XML', 'action class was set';
+is get('/foo/book/Fnord/view/html?page=7'), 'Page 7 of "Fnord" as HTML', 'action class was set';
use CatalystX::Declarative;
+role MyActionYes {
+ around match (@args) { $ENV{TESTAPP_ACTIONROLE} ? $self->$orig(@args) : undef }
+}
+
+role TestApp::Try::Aliasing::MyActionNo {
+ around match (@args) { $ENV{TESTAPP_ACTIONROLE} ? undef : $self->$orig(@args) }
+}
+
+class TestApp::Action::Page extends Catalyst::Action {
+
+ around execute ($controller, $ctx, @args) {
+ my $page = $ctx->request->params->{page} || 1;
+ return $self->$orig($controller, $ctx, @args, page => $page);
+ }
+}
+
controller TestApp::Controller::Foo {
+ use constant MyActionNo => 'TestApp::Try::Aliasing::MyActionNo';
#
# look, a Moose!
}
}
+
+ #
+ # action roles
+ #
+
+ action with_role_yes
+ is final
+ as with_role
+ under base
+ with MyActionYes
+ { $ctx->res->body('YES') };
+
+ action with_role_no
+ is final
+ as with_role
+ under base
+ with MyActionNo
+ { $ctx->res->body('NO') };
+
+
+ #
+ # action classes
+ #
+
+ action book (Str $title) under base {
+ $ctx->stash(title => $title);
+ }
+
+ action view (Str $format, Int :$page) under book isa Page is final {
+ $ctx->response->body(
+ sprintf 'Page %d of "%s" as %s',
+ $page,
+ $ctx->stash->{title},
+ uc($format),
+ );
+ }
}
projects / catagits/CatalystX-Declare.git / commitdiff