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