--- /dev/null
+# VIM swap files
+*.swp
+*.swo
+
+# VIM project files
+*.vim
+
+# root directory files
+/*.txt
+/*.pl
+/Makefile*
+/*.sx
+/*.sxc
+
+# except
+!Makefile.PL
+
+# M:I and builds
+inc/
+blib/
+cover_db/
+pm_to_blib
+test.out
+META.yml
+
+# hidden
+.*
+!.gitignore
+
+# misc
+Debian_CPANTS.txt
--- /dev/null
+[0.001] ...
+ - Initial release
--- /dev/null
+#
+# This file is a modified version of the MANIFEST.SKIP file
+# from DBIx-Class.
+#
+
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+\B\.git\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# for developers only :)
+^TODO$
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\.swp$
+\.swo$
+\#$
+\b\.#
+
+# avoid OS X finder files
+\.DS_Store$
+
+# Don't ship the last dist we built :)
+\.tar\.gz$
+
+# Skip maint stuff
+^maint/
+^Debian_CPANTS\.txt$
--- /dev/null
+use inc::Module::Install;
+
+name 'CatalystX-Declare';
+author 'Robert Sedlacek <rs@474.at>';
+license 'perl';
+
+all_from 'lib/CatalystX/Declare.pm';
+readme_from 'lib/CatalystX/Declare.pm', 'clean';
+
+author_tests 'xt';
+
+requires 'Carp', '1.08';
+requires 'Class::Inspector', '1.24';
+requires 'Perl6::Junction', '1.40000';
+requires 'aliased', '0.22';
+requires 'Data::Dump', '1.14';
+requires 'Catalyst', '5.80007';
+requires 'Moose', '0.88';
+requires 'MooseX::AttributeHelpers', '0.16';
+requires 'MooseX::Declare', '0.23';
+requires 'MooseX::MethodAttributes', '0.15';
+requires 'MooseX::Types', '0.16';
+
+test_requires 'Catalyst::Test';
+test_requires 'FindBin';
+test_requires 'Test::More', '0.86';
+
+repository 'http://github.com/phaylon/catalystx-declarative/tree/master';
+bugtracker 'http://github.com/phaylon/catalystx-declarative/issues';
+
+auto_manifest;
+auto_provides_class;
+
+WriteAll;
use MooseX::Declare;
-class CatalystX::Declare extends MooseX::Declare {
+class CatalystX::Declare extends MooseX::Declare is dirty {
- use aliased 'CatalystX::Declare::Keyword::Controller', 'ControllerKeyword';
+ use aliased 'CatalystX::Declare::Keyword::Controller', 'ControllerKeyword';
+ use aliased 'CatalystX::Declare::Keyword::Role', 'RoleKeyword';
+ use aliased 'CatalystX::Declare::Keyword::Application', 'ApplicationKeyword';
+
+ clean;
+
+ our $VERSION = '0.001';
around keywords {
$self->$orig,
ControllerKeyword->new(identifier => 'controller'),
+ RoleKeyword->new(identifier => 'controller_role'),
+ ApplicationKeyword->new(identifier => 'application'),
}
}
+__END__
+
+=head1 NAME
+
+CatalystX::Declare - EXPERIMENTAL Declarative Syntax for Catalyst Applications
+
+=head1 SYNOPSIS
+
+=head2 Application
+
+ use CatalystX::Declare;
+
+ application MyApp::Web with Static::Simple {
+
+ $CLASS->config(name => 'My Declarative Web Application');
+ }
+
+=head2 Controllers
+
+ use CatalystX::Declare;
+
+ controller MyApp::Web::Controller::Foo
+ with MyApp::Web::ControllerRole::Bar {
+
+ use MooseX::Types::Moose qw( Str );
+
+
+ has welcome_message => (
+ is => 'rw',
+ isa => Str,
+ required => 1,
+ lazy_build => 1,
+ );
+
+ method _build_welcome_message { 'Welcome' }
+
+
+ action base as '';
+
+ under base {
+
+ final action welcome {
+ $ctx->response->body( $self->welcome_message );
+ }
+ }
+ }
+
+=head2 Roles
+
+ use CatalystX::Declare;
+
+ controller_role MyApp::Web::ControllerRole::Bar {
+
+ use MyApp::Types qw( Username );
+
+
+ around _build_welcome_message { $self->$orig . '!' }
+
+ after welcome (Object $ctx) {
+
+ $ctx->response->body(join "\n",
+ $ctx->response->body,
+ time(),
+ );
+ }
+
+
+ final action special_welcome (Username $name) under base {
+
+ $ctx->response->body('Hugs to ' . $name);
+ }
+ }
+
+=head1 DESCRIPTION
+
+This module provides a declarative syntax for L<Catalyst|Catalyst::Runtime>
+applications. Its main focus is currently on common and repetitious parts of
+the application, such as the application class itself, controllers, and
+controller roles.
+
+=head2 Not a Source Filter
+
+The used syntax elements are not parsed via source filter mechanism, but
+through L<Devel::Declare>, which is a much less fragile deal to handle and
+allows extensions to mix without problems. For example, all keywords added
+by this module are separete handlers.
+
+=head2 Syntax Documentation
+
+The documentation about syntax is in the respective parts of the distribution
+below the C<CatalystX::Declare::Keyword::> namespace. Here are the manual
+pages you will be interested in to familiarize yourself with this module's
+syntax extensions:
+
+=over
+
+=item L<CatalystX::Declare::Keyword::Application>
+
+=item L<CatalystX::Declare::Keyword::Controller>
+
+=item L<CatalystX::Declare::Keyword::Action>
+
+=item L<CatalystX::Declare::Keyword::Role>
+
+=back
+
+Things like models, views, roles for request or response objects, can be built
+declaratively with L<MooseX::Declare>, which is used to additionally provide
+keywords for C<class>, C<role>, C<method> and the available method modifier
+declarations. This allows for constructs such as:
+
+ use CatalystX::Declare;
+
+ class Foo {
+
+ method bar { 23 }
+ }
+
+ controller MyApp::Web::Controller::Baz {
+
+ final action qux {
+ $ctx->response->body(Foo->new->bar)
+ }
+ }
+
+=head1 SEE ALSO
+
+=head2 For Usage Information
+
+These links are intended for the common user of this module.
+
+=over
+
+=item L<Catalyst::Runtime>
+
+=item L<Catalyst::Devel>
+
+=item L<Catalyst::Manual>
+
+Although you probably already know Catalyst, since you otherwise probably
+wouldn't be here, I include these links for completeness sake.
+
+=item L<Moose>
+
+The powerful modern Perl object orientation implementation that is used
+as basis for Catalyst. L<MooseX::Declare>, on which L<CatalystX::Declare>
+is based, provides a declarative syntax for L<Moose>.
+
+=item L<MooseX::Declare>
+
+We inherit almost all functionality from L<MooseX::Declare> to allow the
+declaration of traditional classes, roles, methods, modifiers, etc. Refer
+to this documentation first for syntax elements that aren't part of
+L<CatalystX::Declare>.
+
+=item L<MooseX::Method::Signatures>
+
+This isn't directly used, but L<MooseX::Declare> utilises this to provide
+us with method and modifier declarations. For extended information on the
+usage of methods, especially signatures, refer to this module after
+looking for an answer in the L<MooseX::Declare> documentation.
+
+=back
+
+=head2 For Developer Information
+
+This section contains links relevant to the implementation of this module.
+
+=over
+
+=item L<Devel::Declare>
+
+You could call this is the basic machine room that runs the interaction with
+perl. It provides a way to hook into perl's source code parsing and change
+small parts on a per-statement basis.
+
+=item L<MooseX::MethodAttributes>
+
+We use this module to easily communicate the action attributes to
+L<Catalyst|Catalyst::Runtime>. Currently, this is the easiest solution for
+now but may be subject to change in the future.
+
+=back
+
+
+=head1 AUTHOR
+
+=over
+
+=item Robert 'phaylon' Sedlacek, L<E<lt>rs@474.atE<gt>>
+
+=back
+
+With contributions from, and many thanks to:
+
+=over
+
+=item Florian Ragwitz
+
+=item John Napiorkowski
+
+=back
+
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as perl itself.
+
+=cut
use Perl6::Junction qw( any );
use Data::Dump qw( pp );
use MooseX::Types::Util qw( has_available_type_export );
+ use Moose::Util qw( add_method_modifier );
use Class::Inspector;
use Class::MOP;
use aliased 'MooseX::MethodAttributes::Role::Meta::Method', 'AttributeRole';
- method parse (Object $ctx) {
+ method parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0) {
# somewhere to put the attributes
my %attributes;
my @populators;
- my $skipped_declarator;
# parse declarations
until (do { $ctx->skipspace; $ctx->peek_next_char } eq any qw( ; { } )) {
unless exists $attributes{Signature};
my $name = $attributes{Subname};
+
my $method = Method->wrap(
signature => qq{($attributes{Signature})},
package_name => $ctx->get_curstash_name,
return $ctx->shadow(sub (&) {
my $class = caller;
+ my $body = shift;
- $method->_set_actual_body(shift);
+ $method->_set_actual_body($body);
$method->{attributes} = \@attributes;
-
- $class->meta->add_method($name, $method);
- $class->meta->register_method_attributes($class->can($method->name), \@attributes);
+
+ if ($modifier) {
+
+ add_method_modifier $class, $modifier, [$name, $method];
+ }
+ else {
+
+ $class->meta->add_method($name, $method);
+ $class->meta->register_method_attributes($class->can($method->name), \@attributes);
+ }
});
}
}
}
+__END__
+
+=head1 NAME
+
+CatalystX::Declare::Keyword::Action - Declare Catalyst Actions
+
+=head1 SYNOPSIS
+
+ use CatalystX::Declare;
+
+ controller MyApp::Web::Controller::Example {
+
+ # chain base action with path part setting of ''
+ # body-less actions don't do anything by themselves
+ action base as '';
+
+ # simple end-point action
+ action controller_class is final under base {
+ $ctx->response->body( 'controller: ' . ref $self );
+ }
+
+ # chain part actions can have arguments
+ action str (Str $string) under base {
+
+ $ctx->stash(chars => [split //, $string]);
+ }
+
+ # and end point actions too, of course
+ action uc_chars (Int $count) under str is final {
+
+ my $chars = $ctx->stash->{chars};
+ ...
+ }
+
+
+ # you can use a shortcut for multiple actions with
+ # a common base
+ under base {
+
+ # this is an endpoint after base
+ action normal is final;
+
+ # the final keyword can be used to be more
+ # visually explicit about end-points
+ final action some_action { ... }
+ }
+
+ # of course you can also chain to external actions
+ final action some_end under '/some/controller/some/action';
+ }
+
+=head1 DESCRIPTION
+
+This handler class provides the user with C<action>, C<final> and C<under>
+keywords. There are multiple ways to define actions to allow for greater
+freedom of expression. While the parts of the action declaration itself do
+not care about their order, their syntax is rather strict.
+
+You can choose to separate syntax elements via C<,> if you think it is more
+readable. The action declaration
+
+ action foo is final under base;
+
+is parsed in exactly the same way if you write it as
+
+ action foo, is final, under base;
+
+=head2 Basic Action Declaration
+
+The simplest possible declaration is
+
+ action foo;
+
+This would define a chain-part action chained to C</> with the name C<foo>
+and no arguments. Since it isn't followed by a block, the body of the action
+will be empty.
+
+You will automatically be provided with two variables: C<$self> is, as you
+might expect, your controller instance. C<$ctx> will be the Catalyst context
+object. Thus, the following code would stash the value returned by the
+C<get_item> method:
+
+ action foo {
+ $ctx->stash(item => $self->get_item);
+ }
+
+=head2 Setting a Path Part
+
+As usual with Catalyst actions, the path part (the public name of this part of
+the URI, if you're not familiar with the term yet) will default to the name of
+the action itself (or more correctly: to whatever Catalyst defaults).
+
+To change that, use the C<as> option:
+
+ action base as ''; # <empty>
+ action something as 'foo/bar'; # foo/bar
+ action barely as bareword; # bareword
+
+=head2 Chaining Actions
+
+Currently, L<CatalystX::Declare> is completely based on the concept of
+L<chained actions|Catalyst::DispatchType::Chained>. Every action you declare is
+chained to something. No base specification means you chain to the root. You
+can specify the action you want to chain to with the C<under> option:
+
+ action foo; # chained to /
+ action foo under '/'; # also chained to /
+ action foo under bar; # chained to the local bar action
+ action foo under '/bar/baz'; # chained to baz in /bar
+
+C<under> is also provided as a grouping keyword. Every action inside the block
+will be chained to the specified action:
+
+ under base {
+ action foo { ... }
+ action bar { ... }
+ }
+
+You can also use the C<under> keyword for a single action. This is useful if
+you want to highlight a single action with a significant diversion from what
+is to be expected:
+
+ action base;
+
+ under '/the/sink' is final action foo;
+
+ final action bar under base;
+
+ final action baz under base;
+
+Instead of the C<under> option declaration, you can also use a more english
+variant named C<chains to>. While C<under> might be nice and concise, some
+people might prefer this if they confuse C<under> with the specification of
+a public path part. The argument to C<chains to> is the same as to C<under>:
+
+ action foo chains to bar;
+ action foo under bar;
+
+By default all actions are chain-parts, not end-points. If you want an action
+to be picked up as end-point and available via a public path, you have to say
+so explicitely by using the C<is final> option:
+
+ action base;
+ action foo under base is final; # /base/foo
+
+You can also drop the C<is> part of the C<is final> option if you want:
+
+ under base, final action foo { ... }
+
+You can make end-points more visually distinct by using the C<final> keyword
+instead of the option:
+
+ action base;
+ final action foo under base; # /base/foo
+
+And of course, the C<final>, C<under> and C<action> keywords can be used in
+combination whenever needed:
+
+ action base as '';
+
+ under base {
+
+ final action list; # /list
+
+ action load;
+
+ under load {
+
+ final action view; # /list/load/view
+ final action edit; # /list/load/edit
+ }
+ }
+
+There is also one shorthand alternative for declaring chain targets. You can
+specify an action after a C<E<lt>-> following the action name:
+
+ action base;
+ final action foo <- base; # /base/foo
+
+=head2 Arguments
+
+You can use signatures like you are use to from L<MooseX::Method::Signatures>
+to declare action parameters. The number of arguments will be used during
+dispatching. Dispatching by type constraint is planned but not yet implemented.
+
+The signature follows the action name:
+
+ # /foo/*/*/*
+ final action foo (Int $year, Int $month, Int $day);
+
+If you are using the shorthand definition, the signature follows the chain
+target:
+
+ # /foo/*
+ final action foo <- base ($x) { ... }
+
+Parameters may be specified on chain-parts and end-points:
+
+ # /base/*/foo/*
+ action base (Str $lang);
+ final action page (Int $page_num) under base;
+
+Named parameters will be populated with the values in the query parameters:
+
+ # /view/17/?page=3
+ final action view (Int $id, Int :$page = 1);
+
+Your end-points can also take an unspecified amount of arguments by specifying
+an array as a variable:
+
+ # /find/some/deep/path/spec
+ final action find (@path);
+
+=head2 Actions and Method Modifiers
+
+Method modifiers can not only be applied to methods, but also to actions. There
+is no way yet to override the attributes of an already established action via
+modifiers. However, you can modify the method underlying the action.
+
+The following code is an example role modifying the consuming controller's
+C<base> action:
+
+ use CatalystX::Declare;
+
+ controller_role MyApp::Web::ControllerRole::RichBase {
+
+ before base (Object $ctx) {
+ $ctx->stash(something => $ctx->model('Item'));
+ }
+ }
+
+Note that you have to specify the C<$ctx> argument yourself, since you are
+modifying a method, not an action.
+
+Any controller having a C<base> action (or method, for this purpose), can now
+consume the C<RichBase> role declared above:
+
+ use CatalystX::Declare;
+
+ controller MyApp::Web::Controller::Foo
+ with MyApp::Web::Controller::RichBase {
+
+ action base as '';
+
+ action show, final under base {
+ $ctx->response->body(
+ $ctx->stash->{something}->render,
+ );
+ }
+ }
+
+=head1 ROLES
+
+=over
+
+=item L<MooseX::Declare::Syntax::KeywordHandling>
+
+=back
+
+=head1 METHODS
+
+These methods are implementation details. Unless you are extending or
+developing L<CatalystX::Declare>, you should not be concerned with them.
+
+=head2 parse
+
+ Object->parse (Object $ctx, Str :$modifier?, Int :$skipped_declarator = 0)
+
+A hook that will be invoked by L<MooseX::Declare> when this instance is called
+to handle syntax. It will parse the action declaration, prepare attributes and
+add the actions to the controller.
+
+=head1 SEE ALSO
+
+=over
+
+=item L<CatalystX::Declare>
+
+=item L<CatalystX::Declare::Keyword::Controller>
+
+=item L<MooseX::Method::Signatures>
+
+=back
+
+=head1 AUTHOR
+
+See L<CatalystX::Declare/AUTHOR> for author information.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as perl itself.
+=cut
--- /dev/null
+use MooseX::Declare;
+
+class CatalystX::Declare::Keyword::Application
+ extends MooseX::Declare::Syntax::Keyword::Class {
+
+
+ override auto_make_immutable { 0 }
+
+ override add_with_option_customizations (Object $ctx, Str $package, ArrayRef $plugins, HashRef $options) {
+
+ $ctx->add_cleanup_code_parts(
+ sprintf(
+ '%s->setup(qw( %s ))',
+ $package,
+ join(' ', @$plugins),
+ ),
+ '1;',
+ );
+ }
+
+ before add_namespace_customizations (Object $ctx, Str $package) {
+
+ $ctx->add_preamble_code_parts(
+ 'use CLASS',
+ 'use parent q{Catalyst}',
+ );
+ }
+}
+
+=head1 NAME
+
+CatalystX::Declare::Keyword::Application - Declare Catalyst Application Classes
+
+=head1 SYNOPSIS
+
+ use CatalystX::Declare;
+
+ application MyApp::Web
+ with Static::Simple
+ with ConfigLoader {
+
+ $CLASS->config(name => 'My App');
+
+ method debug_timestamp {
+ $self->log->debug('Timestamp: ' . time)
+ if $self->debug;
+ }
+ }
+
+=head1 DESCRIPTION
+
+This module provides a keyword handler for the C<application> keyword. It is an
+extension of L<MooseX::Declare/class>. The role application mechanism behind
+the C<with> specification is hijacked and the arguments are passed to
+Catalyst's C<setup> method. This hijacking is proably going away someday since
+in the future plugins will be actual roles.
+
+You don't have to call the C<setup> method yourself, this will be done by the
+handler after the body has been run. If you need to run code specifically before
+or after the C<setup> method has been run, you can always use method modifiers.
+
+=head1 SUPERCLASSES
+
+=over
+
+=item L<MooseX::Declare::Syntax::Keyword::Class>
+
+=back
+
+=head1 METHODS
+
+=head2 auto_make_immutable
+
+ Bool Object->auto_make_immutable ()
+
+A modified method that returns C<0> to signal to L<MooseX::Declare> that it
+should not make this class immutable. Currently, making application classes
+immutable isn't supported yet, therefore C<is mutable> is currently a no-op.
+This will likely change as soon as application classes can be made immutable,
+
+=head1 SEE ALSO
+
+=over
+
+=item L<CatalystX::Declare>
+
+=item L<MooseX::Declare/class>
+
+=item L<MooseX::Declare::Syntax::Keyword::Class>
+
+=back
+
+=head1 AUTHOR
+
+See L<CatalystX::Declare/AUTHOR> for author information.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as perl itself.
+
+=cut
use aliased 'CatalystX::Declare::Controller::RegisterActionRoles';
use aliased 'CatalystX::Declare::Controller::DetermineActionClass';
+ use Data::Dump qw( pp );
+
before add_namespace_customizations (Object $ctx, Str $package) {
method default_superclasses { 'Catalyst::Controller' }
+ method auto_make_immutable { 0 }
+
+ method add_with_option_customizations (Object $ctx, $package, ArrayRef $roles, HashRef $options) {
+
+ $ctx->add_cleanup_code_parts(
+ map {
+ sprintf('Class::MOP::load_class(%s)', pp "$_"),
+ sprintf('%s->meta->apply(%s->meta)', $_, $package),
+ } @$roles
+ );
+
+ $ctx->add_cleanup_code_parts(
+ sprintf '%s->meta->make_immutable', $package
+ ) unless $options->{is}{mutable};
+ }
+
around default_inner () {
- return [
- @{ $self->$orig() || [] },
+ my @modifiers = qw( );
+
+ return [
+ ( grep { my $id = $_->identifier; not grep { $id eq $_ } @modifiers } @{ $self->$orig() || [] } ),
ActionKeyword->new(identifier => 'action'),
ActionKeyword->new(identifier => 'under'),
ActionKeyword->new(identifier => 'final'),
}
}
+__END__
+
+=head1 NAME
+
+CatalystX::Declare::Keyword::Controller - Declare Catalyst Controllers
+
+=head1 SYNOPSIS
+
+ controller MyApp::Web::Controller::Example
+ extends MyApp::Web::ControllerBase::CRUD
+ with MyApp::Web::ControllerRole::Caching {
+
+
+ $CLASS->config(option_name => 'value');
+
+
+ has attr => (is => 'rw', lazy_build => 1);
+
+ method _build_attr { 'Hello World' }
+
+
+ action base as '';
+
+ final action site, under base {
+ $ctx->response->body( $self->attr );
+ }
+ }
+
+=head1 DESCRIPTION
+
+This handler module allows the declaration of Catalyst controllers. The
+C<controller> keyword is an extension of L<MooseX::Declare/class> with all the
+bells and whistles, including C<extends>, C<with>, C<method> and modifier
+declarations.
+
+In addition to the keywords and features provided by L<MooseX::Declare>, you
+can also specify your controller's actions declaratively. For the whole truth
+about the syntax refer to L<CatalystX::Declare::Keyword::Action>.
+
+For controller roles, please see L<CatalystX::Declare::Keyword::Role>. You can
+extend controllers with the C<extends> keyword and consume roles via C<with> as
+usual.
+
+=head1 SUPERCLASSES
+
+=over
+
+=item L<MooseX::Declare::Syntax::Keyword::Class>
+
+=back
+
+=head1 ROLES
+
+=over
+
+=item L<CatalystX::Declare::DefaultSuperclassing>
+
+=back
+
+=head1 METHODS
+
+These methods are implementation details. Unless you are extending or
+developing L<CatalystX::Declare>, you should not be concerned with them.
+
+=head2 add_namespace_customizations
+
+ Object->add_namespace_customizations (Object $ctx, Str $package)
+
+This method modifier will initialise the controller with
+L<MooseX::MethodAttributes>, import L<CLASS> and add the
+L<CatalystX::Declare::Controller::RegisterActionRoles> and
+L<CatalystX::Declare::Controller::DetermineActionClass> controller roles
+before calling the original.
+
+=head2 default_superclasses
+
+ Str Object->default_superclasses ()
+
+Returns L<Catalyst::Controller> as the default superclass for all declared
+controllers.
+
+=head2 auto_make_immutable
+
+ Bool Object->auto_make_immutable ()
+
+Returns C<0>, indicating that L<MooseX::Declare> should not make this class
+immutable by itself. We will do that in the L</add_with_option_customizations>
+method ourselves.
+
+=head2 add_with_option_customizations
+
+ Object->add_with_option_customizations (
+ Object $ctx,
+ Str $package,
+ ArrayRef $roles,
+ HashRef $options,
+ )
+
+This hook method will be called by L<MooseX::Declare> when C<with> options were
+encountered. It will load the specified class and apply them to the controller
+one at a time. This will change in the future, and they will be all applied
+together.
+
+This method will also add a callback to make the controller immutable to the
+cleanup code parts unless C<is mutable> was specified.
+
+=head2 default_inner
+
+ ArrayRef[Object] Object->default_inner ()
+
+A method modifier around the original. The inner syntax handlers inherited by
+L<MooseX::Declare::Syntax::Keyword::Class> are extended with instances of the
+L<CatalystX::Declare::Keyword::Action> handler class for the C<action>,
+C<under> and C<final> identifiers.
+
+=head1 SEE ALSO
+
+=over
+
+=item L<CatalystX::Declare>
+
+=item L<CatalystX::Declare::Keyword::Action>
+
+=item L<MooseX::Declare/class>
+
+=back
+
+=head1 AUTHOR
+
+See L<CatalystX::Declare/AUTHOR> for author information.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as perl itself.
+
+=cut
--- /dev/null
+use MooseX::Declare;
+
+class CatalystX::Declare::Keyword::Role
+ extends MooseX::Declare::Syntax::Keyword::Role {
+
+
+ use aliased 'MooseX::MethodAttributes::Role::Meta::Role';
+ use aliased 'CatalystX::Declare::Keyword::Action', 'ActionKeyword';
+
+
+ before add_namespace_customizations (Object $ctx, Str $package) {
+
+ $ctx->add_preamble_code_parts(
+ 'use CLASS',
+ 'use Moose::Role -traits => q(MethodAttributes)',
+ );
+ }
+
+ around default_inner () {
+
+ my @modifiers = qw( );
+
+ return [
+ ( grep { my $id = $_->identifier; not grep { $id eq $_ } @modifiers } @{ $self->$orig() || [] } ),
+ ActionKeyword->new(identifier => 'action'),
+ ActionKeyword->new(identifier => 'under'),
+ ActionKeyword->new(identifier => 'final'),
+ ];
+ }
+}
+
+__END__
+
+=head1 NAME
+
+CatalystX::Declare::Keyword::Role - Declare Catalyst Controller Roles
+
+=head1 SYNOPSIS
+
+ use CatalystX::Declare;
+
+ controller_role MyApp::Web::ControllerRole::Foo {
+
+ method provided_method { ... }
+
+ action foo, under base, is final { ... }
+
+ around bar_action (Object $ctx) { ... }
+ }
+
+=head1 DESCRIPTION
+
+This handler provides the C<controller_role> keyword. It is an extension of the
+L<MooseX::Declare::Syntax::Keyword::Role> handler. Like with declared
+controllers, the C<method> keyword and the modifiers are provided. For details
+on the syntax for action declarations have a look at
+L<CatalystX::Declare::Keyword::Action>, which also documents the effects of
+method modifiers on actions.
+
+=head1 SUPERCLASSES
+
+=over
+
+=item L<MooseX::Declare::Syntax::Keyword::Role>
+
+=back
+
+=head1 METHODS
+
+=head2 add_namespace_customizations
+
+ Object->add_namespace_customizations (Object $ctx, Str $package)
+
+This hook is called by L<MooseX::Declare> and will set the package up as a role
+and apply L<MooseX::MethodAttributes>.
+
+=head2 default_inner
+
+ ArrayRef[Object] Object->default_inner ()
+
+Same as L<CatalystX::Declare::Keyword::Class/default_inner>.
+
+=head1 SEE ALSO
+
+=over
+
+=item L<CatalystX::Declare>
+
+=item L<MooseX::Declare/role>
+
+=item L<CatalystX::Declare::Keyword::Action>
+
+=item L<CatalystX::Declare::Keyword::Controller>
+
+=back
+
+=head1 AUTHOR
+
+See L<CatalystX::Declare/AUTHOR> for author information.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as perl itself.
+
+=cut
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More tests => 17;
+use Test::More tests => 21;
use Catalyst::Test 'TestApp';
# simple stuff
# specify chain target directly via action
is get('/foo/pointed/beaver'), 'Your beaver is pointed!', 'chain target specified via action';
+
+# an action from a role
+is get('/foo/action_from_ctrl_role'), 'foo/action_from_ctrl_role', 'action from controller role';
+
+# an action body that was modified
+is get('/foo/modifier_target'), 'foo/modifier_target modified', 'action was modified by role';
+is get('/foo/surrounded_target'), 'foo/surrounded_target surrounded', 'action was modified with around by role';
+
+# inline classes
+is get('/foo/inline_class'), 'HELLO', 'inline classes work as expected';
-package TestApp;
-use strict;
-use warnings;
+use CatalystX::Declare;
-use parent 'Catalyst';
-use Catalyst qw( Static::Simple );
+application TestApp with Static::Simple {
-__PACKAGE__->config(name => 'CatalystX::Declare TestApp');
-__PACKAGE__->setup;
+ $CLASS->config(name => 'CatalystX::Declare TestApp');
+}
-1;
use CatalystX::Declare;
-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) }
-}
+controller TestApp::Controller::Foo with TestApp::TestRole {
+
+ use constant MyActionNo => 'TestApp::Try::Aliasing::MyActionNo';
-class TestApp::Action::Page extends Catalyst::Action {
+ class ::Messenger {
- around execute ($controller, $ctx, @args) {
- my $page = $ctx->request->params->{page} || 1;
- return $self->$orig($controller, $ctx, @args, page => $page);
+ has message => (is => 'rw');
+
+ method format { uc $self->message }
}
-}
-controller TestApp::Controller::Foo {
+ role MyActionYes {
+ around match (@args) { $ENV{TESTAPP_ACTIONROLE} ? $self->$orig(@args) : undef }
+ }
- use constant MyActionNo => 'TestApp::Try::Aliasing::MyActionNo';
+ 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);
+ }
+ }
#
# look, a Moose!
#
action pointed <- base ($what) is final { $ctx->response->body("Your $what is pointed!") }
+
+
+ #
+ # targets for action modifiers
+ #
+
+ action modifier_target under base is final { $ctx->response->body($ctx->action->reverse) }
+
+ action surrounded_target under base is final {
+ $ctx->response->body(join ' ', $ctx->action->reverse, $ctx->response->body || ());
+ }
+
+
+ #
+ # inline classes
+ #
+
+ final action inline_class under base {
+ $ctx->response->body( TestApp::Controller::Foo::Messenger->new(message => 'Hello')->format );
+ }
}
--- /dev/null
+use CatalystX::Declare;
+
+controller_role TestApp::TestRole {
+
+ method something_from_the_role { 23 }
+
+ final action action_from_ctrl_role under base {
+ $ctx->response->body($ctx->action->reverse);
+ }
+
+ after modifier_target (Object $ctx) {
+ $ctx->response->body(join ' ', $ctx->response->body, 'modified');
+ }
+
+ around surrounded_target (Object $ctx) {
+ $ctx->response->body('surrounded');
+ $self->$orig($ctx);
+ }
+}
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Test::More;
+
+eval {
+ # autogenerated files are excluded
+ # use strict is implied by Moose & Co.
+ require Test::Kwalitee; Test::Kwalitee->import(
+ tests => [qw(
+ -use_strict
+ -has_manifest
+ -has_test_pod_coverage
+ )],
+ );
+};
+
+plan skip_all => 'Test::Kwalitee not installed; skipping' if $@;
--- /dev/null
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod 1.00";
+
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+all_pod_files_ok();
projects / catagits/CatalystX-Declare.git / commitdiff