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]; },
  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         foreach my $component_name ('MyApp::Component1') {
 147             my $component_config = $c->config->{$component_name};
 148             # Calling this method creates a component, and registers it in your application
 149             $self->_setup_one_of_my_components($component_name, $component_config);
 150         }
 151     }
 152
 153 =head1 DESCRIPTION
 154
 155 CatalystX::DynamicComponent aims to provide a flexible and reuseable method of building generic
 156 Catalyst components and registering them with your application.
 157
 158 To give you this flexibility, it is implemented as a parametrised role which curries a
 159 component builder into your current package at application time.
 160
 161 Authors of specific dynamic component builders are expected to be implemented as application class
 162 roles which compose this role, but provide their own advice around the C<< setup_compontens >>
 163 method, and call the curried method from this role once for each component you wish to setup.
 164
 165 =head1 PARAMETERS
 166
 167 =head2 name
 168
 169 B<Required> - The name of the component generator method to curry.
 170
 171 =head2 COMPONENT
 172
 173 Optional, either a L<Class::MOP::Method>, or a plain code ref of a COMPONENT method to apply to
 174 the dynamically generated package before making it immutable.
 175
 176 =head2 pre_immutable_hook
 177
 178 Optional, method to call after a component has been generated, but before it is made immutable,
 179 constructed, and added to your component registry.
 180
 181 =head1 CURRIED COMPONENT GENERATOR
 182
 183 =head2 ARGUMENTS
 184
 185 =over
 186
 187 =item *
 188
 189 $component_name (E.g. C<< MyApp::Controller::Foo >>)
 190
 191 =item *
 192
 193 $config (E.g. C<< $c->config->{$component_name} >>)
 194
 195 =back
 196
 197 =head2 OPERATION
 198
 199 FIXME
 200
 201 =head1 TODO
 202
 203 =over
 204
 205 =item *
 206
 207 Better default handling of config - by default component should get config from where it normally
 208 does!
 209
 210 =item *
 211
 212 Abstract handling of role application / class name. This should not just be the component config
 213 by default.
 214
 215 =item *
 216
 217 Test pre_immutable hook in tests
 218
 219 =item *
 220
 221 More tests fixme?
 222
 223 =back
 224
 225 =head1 BUGS
 226
 227 Probably plenty, test suite certainly isn't comprehensive.. Patches welcome.
 228
 229 =head1 AUTHOR
 230
 231 Tomas Doran (t0m) <bobtfish@bobtfish.net>
 232
 233 =head1 LICENSE
 234
 235 This code is copyright (c) 2009 Tomas Doran. This code is licensed on the same terms as perl
 236 itself.
 237
 238 =cut
 239