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