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