lib/CatalystX/DynamicComponent.pm

   1 package CatalystX::DynamicComponent;
   2 use MooseX::Role::Parameterized;
   3 use MooseX::Types::Moose qw/Str CodeRef HashRef ArrayRef/;
   4 use Catalyst::Utils;
   5 use Moose::Util::TypeConstraints;
   6 use List::MoreUtils qw/uniq/;
   7 use namespace::autoclean;
   8
   9 enum __PACKAGE__ . '::ResolveStrategy' => qw/
  10     merge
  11     replace
  12 /;
  13
  14 our $VERSION = 0.000001;
  15
  16 parameter 'name' => (
  17     isa => Str,
  18     required => 1,
  19 );
  20
  21 parameter 'pre_immutable_hook' => (
  22     isa => CodeRef|Str,
  23     predicate => 'has_pre_immutable_hook',
  24 );
  25
  26 my $coerceablearray = subtype ArrayRef;
  27 coerce $coerceablearray, from Str, via { [ $_ ] };
  28
  29 my %parameters = (
  30     methods => {
  31         isa =>HashRef,
  32         default => sub { {} },
  33         resolve_strategy => 'merge',
  34     },
  35     roles => {
  36         isa => $coerceablearray, coerce => 1,
  37         default => sub { [] },
  38         resolve_strategy => 'merge',
  39     },
  40     superclasses => {
  41         isa => $coerceablearray, coerce => 1,
  42         default => sub { [] },
  43         resolve_strategy => 'replace',
  44     },
  45 );
  46
  47 # Shameless metaprogramming.
  48 foreach my $name (keys %parameters) {
  49     my $resolve_strategy = delete $parameters{$name}->{resolve_strategy};
  50
  51     parameter $name, %{ $parameters{$name} };
  52
  53     parameter $name . '_resolve_strategy' => (
  54         isa => __PACKAGE__ . '::ResolveStrategy',
  55         default => $resolve_strategy,
  56     );
  57 }
  58
  59 # Code refs to implement the strategy types
  60 my %strategies = ( # Right hand precedence where appropriate
  61     replace => sub {
  62         $_[0] = [ $_[0] ] if $_[0] && !ref $_[0];
  63         $_[1] = [ $_[1] ] if $_[1] && !ref $_[1];
  64         $_[1] ? $_[1] : $_[0];
  65     },
  66     merge => sub {
  67         $_[0] = [ $_[0] ] if $_[0] && !ref $_[0];
  68         $_[1] = [ $_[1] ] if $_[1] && !ref $_[1];
  69         if (ref($_[0]) eq 'ARRAY' || ref($_[1]) eq 'ARRAY') {
  70             [ uniq( @{ $_[0] }, @{ $_[1] } ) ];
  71         }
  72         else {
  73             Catalyst::Utils::merge_hashes(shift, shift);
  74         }
  75     },
  76 );
  77
  78 # Wrap all the crazy up in a method to generically merge configs.
  79 my $get_resolved_config = sub {
  80     my ($name, $p, $config) = @_;
  81     my $get_strategy_method_name = $name . '_resolve_strategy';
  82     my $strategy = $strategies{$p->$get_strategy_method_name()};
  83     $strategy->($p->$name, $config->{$name})
  84         || $parameters{$name}->{default}->();
  85 };
  86
  87 role {
  88     my $p = shift;
  89     my $name = $p->name;
  90     my $pre_immutable_hook = $p->pre_immutable_hook;
  91
  92     method $name => sub {
  93         my ($app, $name, $config) = @_;
  94         my $appclass = blessed($app) || $app;
  95
  96         $config ||= {};
  97
  98         my $type = $name;
  99         $type =~ s/::.*$//;
 100
 101         my $component_name = $appclass . '::' . $name;
 102         my $meta = Moose->init_meta( for_class => $component_name );
 103
 104         my @superclasses = @{ $get_resolved_config->('superclasses', $p, $config) };
 105         push(@superclasses, 'Catalyst::' . $type) unless @superclasses;
 106         $meta->superclasses(@superclasses);
 107
 108         my $methods = $get_resolved_config->('methods', $p, $config);
 109         foreach my $method_name (keys %$methods) {
 110             $meta->add_method($method_name => $methods->{$method_name});
 111         }
 112
 113         if (my @roles = @{ $get_resolved_config->('roles', $p, $config) }) {
 114             Moose::Util::apply_all_roles( $component_name, @roles);
 115         }
 116
 117         if ($p->has_pre_immutable_hook) {
 118             if (!ref($pre_immutable_hook)) {
 119                 $app->$pre_immutable_hook($meta, $config);
 120             }
 121             else {
 122                 $pre_immutable_hook->($meta, $config);
 123             }
 124         }
 125
 126         $meta->make_immutable;
 127
 128         my $instance = $app->setup_component($component_name);
 129         $app->components->{ $component_name } = $instance;
 130     };
 131 };
 132
 133 1;
 134
 135 __END__
 136
 137 =head1 NAME
 138
 139 CatalystX::DynamicComponent - Parameterised Moose role providing functionality to build Catalyst components at runtime.
 140
 141 =head1 SYNOPSIS
 142
 143     package My::DynamicComponentType;
 144     use Moose::Role;
 145     use namespace::autoclean;
 146
 147     with 'CatalystX::DynamicComponent' => {
 148         name => '_setup_one_of_my_components', # Name of injected method
 149     };
 150
 151     after setup_components => sub { shift->_setup_all_my_components(@_); };
 152
 153     sub _setup_all_my_components {
 154         my ($self, $c) = @_;
 155         my $app = ref($self) || $self;
 156         foreach my $component_name ('Controller::Foo') {
 157             my %component_config = %{ $c->config->{$component_name} };
 158             # Shallow copy so we avoid stuffing methods back in the config, as that's lame!
 159             $component_config{methods} = {
 160                 some_method => sub { 'foo' },
 161             };
 162
 163             # Calling this method creates a component, and registers it in your application
 164             # This component will subclass 'MyApp::ControllerBase', do 'MyApp::ControllerRole'
 165             # and have a method called 'some_method' which will return the value 'foo'..
 166             $self->_setup_one_of_my_components($app . '::' . $component_name, \%component_config);
 167         }
 168     }
 169
 170     package MyApp;
 171     use Moose;
 172     use namespace::autoclean;
 173     use Catalyst qw/
 174         +My::DynameComponentType
 175     /;
 176     __PACKAGE__->config(
 177         name => 'MyApp',
 178         'Controller::Foo' => {
 179             superclasses => [qw/MyApp::ControllerBase/],
 180             roles => [qw/MyApp::ControllerRole/],
 181         },
 182     );
 183     __PACKAGE__->setup;
 184
 185 =head1 DESCRIPTION
 186
 187 CatalystX::DynamicComponent aims to provide a flexible and reuseable method of building L<Roles|Moose::Role>
 188 which can be added to L<Catalyst> applications, which generate components dynamically at application
 189 startup using the L<Moose> meta model.
 190
 191 Thi is implemented as a parametrised role which curries a
 192 component builder method into your current package at application time.
 193
 194 Authors of specific dynamic component builders are expected implement an application class
 195 roles which composes this role, and their own advice after the C<< setup_compontents >>
 196 method, which will call the component generation method provided by using this role once
 197 for each component you wish to create.
 198
 199 =head1 PARAMETERS
 200
 201 =head2 name
 202
 203 B<Required> - The name of the component generator method to curry.
 204
 205 =head2 methods
 206
 207 Optional, a hash reference with keys being method names, and values being a L<Class::MOP::Method>,
 208 or a plain code ref of a method to apply to
 209 the dynamically generated package before making it immutable.
 210
 211 =head2 roles
 212
 213 Optional, an array reference of roles to apply to the generated component
 214
 215 =head2 superclasses
 216
 217 Optional, an array reference of superclasses to give the generated component.
 218
 219 If this is not defined, and not passed in as an argument to the generation method,
 220 then Catalyst::(Model|View|Controller) will used as the base class (as appropriate given
 221 the requested namespace of the generated class, otherwise Catalyst::Component will be used.
 222
 223 FIXME - Need tests for this.
 224
 225 =head2 pre_immutable_hook
 226
 227 Optional, either a coderef, which will be called with the component $meta and the merged $config,
 228 or a string name of a method to call on the application class, with the same parameters.
 229
 230 This hook is called after a component has been generated and methods added, but before it is made
 231 immutable, constructed, and added to your component registry.
 232
 233 =head1 CURRIED COMPONENT GENERATOR
 234
 235 =head2 ARGUMENTS
 236
 237 =over
 238
 239 =item *
 240
 241 $component_name (E.g. C<< MyApp::Controller::Foo >>)
 242
 243 =item *
 244
 245 $config (E.g. C<< $c->config->{$component_name} >>)
 246
 247 =back
 248
 249 =head3 config
 250
 251 It is possible to set each of the roles, methods and superclasses parameters for each generated package
 252 individually by defining those keys in the C< $config > parameter to your curried component generation method.
 253
 254 By default, roles and methods supplied from the curried role, and those passed as config will be merged.
 255
 256 Superclasses, no the other hand, will replace those from the curried configuration if passed as options.
 257 This is to discourage accidental use of multiple inheritence, if you need this feature enabled, you should
 258 probably be using Roles instead!
 259
 260 It is possible to change the default behavior of each parameter by passing a
 261 C< $param_name.'_resolve_strategy' > parameter when currying a class generator, with values of either
 262 C<merge> or C<replace>.
 263
 264 Example:
 265
 266     package My::ComponentGenerator;
 267     use Moose;
 268
 269     with 'CatalystX::DynamicComponent' => {
 270         name => 'generate_magic_component',
 271         roles => ['My::Role'],
 272         roles_resolve_strategy => 'replace',
 273     };
 274
 275     package MyApp;
 276     use Moose;
 277     use Catalyst qw/
 278         My::ComponentGenerator
 279     /;
 280     extends 'Catalyst';
 281     after 'setup_components' => sub {
 282         my ($app) = @_;
 283         # Component generated has no roles
 284         $app->generate_magic_component('MyApp::Controller::Foo', { roles => [] });
 285         # Component generated does My::Role
 286         $app->generate_magic_component('MyApp::Controller::Foo', {} );
 287     };
 288     __PACKAGE__->setup;
 289
 290 =head2 OPERATION
 291
 292 FIXME
 293
 294 =head1 TODO
 295
 296 =over
 297
 298 =item *
 299
 300 Test pre_immutable hook in tests
 301
 302 =item *
 303
 304 More tests fixme?
 305
 306 =item *
 307
 308 Unlame needing to pass fully qualified component name in, that's retarded...
 309
 310 Remember to fix the docs and clients too ;)
 311
 312 =item *
 313
 314 Tests for roles giving advice to methods which have just been added..
 315
 316 =back
 317
 318 =head1 LINKS
 319
 320 L<Catalyst>, L<MooseX::MethodAttributes>, L<CatalystX::ModelsFromConfig>.
 321
 322 =head1 BUGS
 323
 324 Probably plenty, test suite certainly isn't comprehensive.. Patches welcome.
 325
 326 =head1 AUTHOR
 327
 328 Tomas Doran (t0m) <bobtfish@bobtfish.net>
 329
 330 =head1 LICENSE
 331
 332 This code is copyright (c) 2009 Tomas Doran. This code is licensed on the same terms as perl
 333 itself.
 334
 335 =cut
 336