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