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 => 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         $app->$pre_immutable_hook($meta) if $p->has_pre_immutable_hook;
 104
 105         my $methods = $get_resolved_config->('methods', $p, $config);
 106         foreach my $name (keys %$methods) {
 107             $meta->add_method($name => $methods->{$name});
 108         }
 109         $meta->make_immutable;
 110
 111         my $instance = $app->setup_component($name);
 112         $app->components->{ $name } = $instance;
 113     };
 114 };
 115
 116 1;
 117
 118 __END__
 119
 120 =head1 NAME
 121
 122 CatalystX::DynamicComponent - Parameterised Moose role providing functionality to build Catalyst components at runtime.
 123
 124 =head1 SYNOPSIS
 125
 126     package My::DynamicComponentType;
 127     use Moose::Role;
 128     use namespace::autoclean;
 129
 130     with 'CatalystX::DynamicComponent' => {
 131         name => '_setup_one_of_my_components', # Name of injected method
 132     };
 133
 134     after setup_components => sub { shift->_setup_all_my_components(@_); };
 135
 136     sub _setup_all_my_components {
 137         my ($self, $c) = @_;
 138         foreach my $component_name ('MyApp::Component1') {
 139             my $component_config = $c->config->{$component_name};
 140             # Calling this method creates a component, and registers it in your application
 141             $self->_setup_one_of_my_components($component_name, $component_config);
 142         }
 143     }
 144
 145 =head1 DESCRIPTION
 146
 147 CatalystX::DynamicComponent aims to provide a flexible and reuseable method of building generic
 148 Catalyst components and registering them with your application.
 149
 150 To give you this flexibility, it is implemented as a parametrised role which curries a
 151 component builder into your current package at application time.
 152
 153 Authors of specific dynamic component builders are expected to be implemented as application class
 154 roles which compose this role, but provide their own advice around the C<< setup_compontens >>
 155 method, and call the curried method from this role once for each component you wish to setup.
 156
 157 =head1 PARAMETERS
 158
 159 =head2 name
 160
 161 B<Required> - The name of the component generator method to curry.
 162
 163 =head2 COMPONENT
 164
 165 Optional, either a L<Class::MOP::Method>, or a plain code ref of a COMPONENT method to apply to
 166 the dynamically generated package before making it immutable.
 167
 168 =head2 pre_immutable_hook
 169
 170 Optional, method to call after a component has been generated, but before it is made immutable,
 171 constructed, and added to your component registry.
 172
 173 =head1 CURRIED COMPONENT GENERATOR
 174
 175 =head2 ARGUMENTS
 176
 177 =over
 178
 179 =item $component_name (E.g. C<< MyApp::Controller::Foo >>)
 180
 181 =item $config (E.g. C<< $c->config->{$component_name} >>)
 182
 183 =head2 OPERATION
 184
 185 FIXME
 186
 187 =head1 TODO
 188
 189 =over
 190
 191 =item *
 192
 193 Better default handling of config - by default component should get config from where it normally
 194 does!
 195
 196 =item *
 197
 198 Abstract handling of role application / class name. This should not just be the component config
 199 by default.
 200
 201 =item *
 202
 203 Have some actual tests which test just this crap, and not all the other classes together.
 204
 205 =back
 206
 207 =head1 BUGS
 208
 209 Probably plenty, test suite certainly isn't comprehensive.. Patches welcome.
 210
 211 =head1 AUTHOR
 212
 213 Tomas Doran (t0m) <bobtfish@bobtfish.net>
 214
 215 =head1 LICENSE
 216
 217 This code is copyright (c) 2009 Tomas Doran. This code is licensed on the same terms as perl
 218 itself.
 219
 220 =cut
 221