X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalystX%2FDynamicComponent.pm;h=a8e489cd3e2e193f8c3a41902ff41e8d9c52b376;hb=72b522424833b0e7ecf67dda4e307396cd0f25ce;hp=39276c4e906a83a265a00e1f79bf7ce716e52657;hpb=00b934f167bed6486682e33b0d332343a7c2cec4;p=catagits%2FCatalystX-DynamicComponent.git diff --git a/lib/CatalystX/DynamicComponent.pm b/lib/CatalystX/DynamicComponent.pm index 39276c4..a8e489c 100644 --- a/lib/CatalystX/DynamicComponent.pm +++ b/lib/CatalystX/DynamicComponent.pm @@ -1,55 +1,337 @@ package CatalystX::DynamicComponent; use MooseX::Role::Parameterized; +use MooseX::Types::Moose qw/Str CodeRef HashRef ArrayRef/; +use Catalyst::Utils; +use Moose::Util::TypeConstraints; +use List::MoreUtils qw/uniq/; +use Moose::Autobox; use namespace::autoclean; +enum __PACKAGE__ . '::ResolveStrategy' => qw/ + merge + replace +/; + our $VERSION = 0.000001; parameter 'name' => ( - isa => 'Str', + isa => Str, required => 1, ); parameter 'pre_immutable_hook' => ( - isa => 'Str', + isa => CodeRef|Str, predicate => 'has_pre_immutable_hook', ); -parameter 'COMPONENT' => ( - isa => 'CodeRef', - predicate => 'has_custom_component_method', +my $coerceablearray = subtype ArrayRef; +coerce $coerceablearray, from Str, via { [ $_ ] }; + +my %parameters = ( + methods => { + isa =>HashRef, + default => sub { {} }, + resolve_strategy => 'merge', + }, + roles => { + isa => $coerceablearray, coerce => 1, + default => sub { [] }, + resolve_strategy => 'merge', + }, + superclasses => { + isa => $coerceablearray, coerce => 1, + default => sub { [] }, + resolve_strategy => 'replace', + }, +); + +# Shameless metaprogramming. +foreach my $name (keys %parameters) { + my $resolve_strategy = delete $parameters{$name}->{resolve_strategy}; + + parameter $name, %{ $parameters{$name} }; + + parameter $name . '_resolve_strategy' => ( + isa => __PACKAGE__ . '::ResolveStrategy', + default => $resolve_strategy, + ); +} + +# Code refs to implement the strategy types +my %strategies = ( # Right hand precedence where appropriate + replace => sub { + $_[0] = [ $_[0] ] if $_[0] && !ref $_[0]; + $_[1] = [ $_[1] ] if $_[1] && !ref $_[1]; + $_[1] ? $_[1] : $_[0]; + }, + merge => sub { + $_[0] = [ $_[0] ] if $_[0] && !ref $_[0]; + $_[1] = [ $_[1] ] if $_[1] && !ref $_[1]; + if (ref($_[0]) eq 'ARRAY' || ref($_[1]) eq 'ARRAY') { + [ uniq( @{ $_[0] }, @{ $_[1] } ) ]; + } + else { + Catalyst::Utils::merge_hashes(shift, shift); + } + }, ); +# Wrap all the crazy up in a method to generically merge configs. +my $get_resolved_config = sub { + my ($name, $p, $config) = @_; + my $get_strategy_method_name = $name . '_resolve_strategy'; + my $strategy = $strategies{$p->$get_strategy_method_name()}; + $strategy->($p->$name, $config->{$name}) + || $parameters{$name}->{default}->(); +}; + role { my $p = shift; my $name = $p->name; my $pre_immutable_hook = $p->pre_immutable_hook; - method $name => sub { - my ($app, $name, $config, $methods) = @_; + method $name => sub { + my ($app, $name, $config) = @_; my $appclass = blessed($app) || $app; + + $config ||= {}; + my $type = $name; - $type =~ s/^${appclass}:://; # FIXME - I think there is shit in C::Utils to do this. $type =~ s/::.*$//; - my $meta = Moose->init_meta( for_class => $name ); - $meta->superclasses('Catalyst::' . $type); + my $component_name = $appclass . '::' . $name; + my $meta = Moose->init_meta( for_class => $component_name ); - if ($p->has_custom_component_method) { - $meta->add_method(COMPONENT => $p->COMPONENT); + my @superclasses = @{ $get_resolved_config->('superclasses', $p, $config) }; + push(@superclasses, 'Catalyst::' . $type) unless @superclasses; + $meta->superclasses(@superclasses); + + my $methods = $get_resolved_config->('methods', $p, $config); + foreach my $method_name (keys %$methods) { + $meta->add_method($method_name => $methods->{$method_name}); } - $app->$pre_immutable_hook($meta) if $p->has_pre_immutable_hook; + if (my @roles = @{ $get_resolved_config->('roles', $p, $config) }) { + Moose::Util::apply_all_roles( $component_name, @roles); + } - $methods ||= {}; - foreach my $name (keys %$methods) { - $meta->add_method($name => $methods->{$name}); + if ($p->has_pre_immutable_hook) { + if (!ref($pre_immutable_hook)) { + $app->$pre_immutable_hook($meta, $config); + } + else { + $pre_immutable_hook->($meta, $config); + } } + $meta->make_immutable; - my $instance = $app->setup_component($name); - $app->components->{ $name } = $instance; + my $instance = $app->setup_component($component_name); + $app->components->{ $component_name } = $instance; }; }; 1; +__END__ + +=head1 NAME + +CatalystX::DynamicComponent - Parameterised Moose role providing functionality to build Catalyst components at runtime. + +=head1 SYNOPSIS + + package My::DynamicComponentType; + use Moose::Role; + use namespace::autoclean; + + with 'CatalystX::DynamicComponent' => { + name => '_setup_one_of_my_components', # Name of injected method + }; + + after setup_components => sub { shift->_setup_all_my_components(@_); }; + + sub _setup_all_my_components { + my ($self, $c) = @_; + my $app = ref($self) || $self; + foreach my $component_name ('Controller::Foo') { + my %component_config = %{ $c->config->{$component_name} }; + # Shallow copy so we avoid stuffing methods back in the config, as that's lame! + $component_config{methods} = { + some_method => sub { 'foo' }, + }; + + # Calling this method creates a component, and registers it in your application + # This component will subclass 'MyApp::ControllerBase', do 'MyApp::ControllerRole' + # and have a method called 'some_method' which will return the value 'foo'.. + $self->_setup_one_of_my_components($app . '::' . $component_name, \%component_config); + } + } + + package MyApp; + use Moose; + use namespace::autoclean; + use Catalyst qw/ + +My::DynameComponentType + /; + __PACKAGE__->config( + name => 'MyApp', + 'Controller::Foo' => { + superclasses => [qw/MyApp::ControllerBase/], + roles => [qw/MyApp::ControllerRole/], + }, + ); + __PACKAGE__->setup; + +=head1 DESCRIPTION + +CatalystX::DynamicComponent aims to provide a flexible and reuseable method of building L +which can be added to L applications, which generate components dynamically at application +startup using the L meta model. + +Thi is implemented as a parametrised role which curries a +component builder method into your current package at application time. + +Authors of specific dynamic component builders are expected implement an application class +roles which composes this role, and their own advice after the C<< setup_compontents >> +method, which will call the component generation method provided by using this role once +for each component you wish to create. + +=head1 PARAMETERS + +=head2 name + +B - The name of the component generator method to curry. + +=head2 methods + +Optional, a hash reference with keys being method names, and values being a L, +or a plain code ref of a method to apply to +the dynamically generated package before making it immutable. + +=head2 roles + +Optional, an array reference of roles to apply to the generated component + +=head2 superclasses + +Optional, an array reference of superclasses to give the generated component. + +If this is not defined, and not passed in as an argument to the generation method, +then Catalyst::(Model|View|Controller) will used as the base class (as appropriate given +the requested namespace of the generated class, otherwise Catalyst::Component will be used. + +FIXME - Need tests for this. + +=head2 pre_immutable_hook + +Optional, either a coderef, which will be called with the component $meta and the merged $config, +or a string name of a method to call on the application class, with the same parameters. + +This hook is called after a component has been generated and methods added, but before it is made +immutable, constructed, and added to your component registry. + +=head1 CURRIED COMPONENT GENERATOR + +=head2 ARGUMENTS + +=over + +=item * + +$component_name (E.g. C<< MyApp::Controller::Foo >>) + +=item * + +$config (E.g. C<< $c->config->{$component_name} >>) + +=back + +=head3 config + +It is possible to set each of the roles, methods and superclasses parameters for each generated package +individually by defining those keys in the C< $config > parameter to your curried component generation method. + +By default, roles and methods supplied from the curried role, and those passed as config will be merged. + +Superclasses, no the other hand, will replace those from the curried configuration if passed as options. +This is to discourage accidental use of multiple inheritence, if you need this feature enabled, you should +probably be using Roles instead! + +It is possible to change the default behavior of each parameter by passing a +C< $param_name.'_resolve_strategy' > parameter when currying a class generator, with values of either +C or C. + +Example: + + package My::ComponentGenerator; + use Moose; + + with 'CatalystX::DynamicComponent' => { + name => 'generate_magic_component', + roles => ['My::Role'], + roles_resolve_strategy => 'replace', + }; + + package MyApp; + use Moose; + use Catalyst qw/ + My::ComponentGenerator + /; + extends 'Catalyst'; + after 'setup_components' => sub { + my ($app) = @_; + # Component generated has no roles + $app->generate_magic_component('MyApp::Controller::Foo', { roles => [] }); + # Component generated does My::Role + $app->generate_magic_component('MyApp::Controller::Foo', {} ); + }; + __PACKAGE__->setup; + +=head2 OPERATION + +FIXME + +=head1 TODO + +=over + +=item * + +Test pre_immutable hook in tests + +=item * + +More tests fixme? + +=item * + +Unlame needing to pass fully qualified component name in, that's retarded... + +Remember to fix the docs and clients too ;) + +=item * + +Tests for roles giving advice to methods which have just been added.. + +=back + +=head1 LINKS + +L, L, L. + +=head1 BUGS + +Probably plenty, test suite certainly isn't comprehensive.. Patches welcome. + +=head1 AUTHOR + +Tomas Doran (t0m) + +=head1 LICENSE + +This code is copyright (c) 2009 Tomas Doran. This code is licensed on the same terms as perl +itself. + +=cut +