Get rid of all messing with action registration by just stuffing the attributes onto...

[catagits/CatalystX-DynamicComponent.git] / lib / CatalystX / DynamicComponent.pm

package CatalystX::DynamicComponent;
use MooseX::Role::Parameterized;
use MooseX::Types::Moose qw/Str CodeRef HashRef ArrayRef/;
use Catalyst::Utils;
use Moose::Util::TypeConstraints;
use List::MoreUtils qw/uniq/;
use namespace::autoclean;

enum __PACKAGE__ . '::ResolveStrategy' => qw/
    merge
    replace
/;

our $VERSION = 0.000001;

parameter 'name' => (
    isa => Str,
    required => 1,
);

parameter 'pre_immutable_hook' => (
    isa => CodeRef|Str,
    predicate => 'has_pre_immutable_hook',
);

my %parameters = (
    methods => {
        isa =>HashRef, 
        default => sub { {} },
        resolve_strategy => 'merge',
    },
    roles => {
        isa => ArrayRef,
        default => sub { [] },
        resolve_strategy => 'merge',
    },
    superclasses => {
        isa => ArrayRef,
        default => sub { [] },
        resolve_strategy => 'replace',
    },
); 

# Shameless metaprogramming.
foreach my $name (keys %parameters) {
    my $resolve_strategy = delete $parameters{$name}->{resolve_strategy};

    parameter $name, %{ $parameters{$name} };

    parameter $name . '_resolve_strategy' => (
        isa => __PACKAGE__ . '::ResolveStrategy',
        default => $resolve_strategy,
    );
}

# Code refs to implement the strategy types
my %strategies = ( # Right hand precedence where appropriate
    replace => sub { $_[1]; },
    merge => sub {
        if (ref($_[0]) eq 'ARRAY') {
            [ uniq( @{ $_[0] }, @{ $_[1] } ) ];
        }
        else {
            Catalyst::Utils::merge_hashes(shift, shift);
        }
    },
);

# Wrap all the crazy up in a method to generically merge configs.
my $get_resolved_config = sub {
    my ($name, $p, $config) = @_;
    my $get_strategy_method_name = $name . '_resolve_strategy';
    my $strategy = $strategies{$p->$get_strategy_method_name()};
    $strategy->($p->$name, $config->{$name})
        || $parameters{$name}->{default}->();
};

role {
    my $p = shift;
    my $name = $p->name;
    my $pre_immutable_hook = $p->pre_immutable_hook;

    method $name => sub {
        my ($app, $name, $config) = @_;

        $config ||= {};

        my $appclass = blessed($app) || $app;
        my $type = $name;
        $type =~ s/^${appclass}:://; # FIXME - I think there is shit in C::Utils to do this.
        $type =~ s/::.*$//;

        my $meta = Moose->init_meta( for_class => $name );

        my @superclasses = @{ $get_resolved_config->('superclasses', $p, $config) };
        push(@superclasses, 'Catalyst::' . $type) unless @superclasses;
        $meta->superclasses(@superclasses);

        if (my @roles = @{ $get_resolved_config->('roles', $p, $config) }) {
            Moose::Util::apply_all_roles( $name, @roles);
        }

        my $methods = $get_resolved_config->('methods', $p, $config);
        foreach my $name (keys %$methods) {
            $meta->add_method($name => $methods->{$name});
        }
 
        if ($p->has_pre_immutable_hook) {
            if (!ref($pre_immutable_hook)) {
                $app->$pre_immutable_hook($meta, $config);
            }
            else {
                $pre_immutable_hook->($meta, $config);
            }
        }

        $meta->make_immutable;

        my $instance = $app->setup_component($name);
        $app->components->{ $name } = $instance;
    };
};

1;

__END__

=head1 NAME

CatalystX::DynamicComponent - Parameterised Moose role providing functionality to build Catalyst components at runtime.

=head1 SYNOPSIS

    package My::DynamicComponentType;
    use Moose::Role;
    use namespace::autoclean;

    with 'CatalystX::DynamicComponent' => {
        name => '_setup_one_of_my_components', # Name of injected method
    };

    after setup_components => sub { shift->_setup_all_my_components(@_); };

    sub _setup_all_my_components {
        my ($self, $c) = @_;
        foreach my $component_name ('MyApp::Component1') {
            my $component_config = $c->config->{$component_name};
            # Calling this method creates a component, and registers it in your application
            $self->_setup_one_of_my_components($component_name, $component_config);
        }
    }

=head1 DESCRIPTION

CatalystX::DynamicComponent aims to provide a flexible and reuseable method of building generic
Catalyst components and registering them with your application.

To give you this flexibility, it is implemented as a parametrised role which curries a
component builder into your current package at application time.

Authors of specific dynamic component builders are expected to be implemented as application class
roles which compose this role, but provide their own advice around the C<< setup_compontens >>
method, and call the curried method from this role once for each component you wish to setup.

=head1 PARAMETERS

=head2 name

B<Required> - The name of the component generator method to curry.

=head2 COMPONENT

Optional, either a L<Class::MOP::Method>, or a plain code ref of a COMPONENT method to apply to
the dynamically generated package before making it immutable.

=head2 pre_immutable_hook

Optional, method to call after a component has been generated, but before it is made immutable,
constructed, and added to your component registry.

=head1 CURRIED COMPONENT GENERATOR

=head2 ARGUMENTS

=over

=item *

$component_name (E.g. C<< MyApp::Controller::Foo >>)

=item *

$config (E.g. C<< $c->config->{$component_name} >>)

=back

=head2 OPERATION

FIXME

=head1 TODO

=over

=item *

Better default handling of config - by default component should get config from where it normally
does!

=item *

Abstract handling of role application / class name. This should not just be the component config
by default.

=item *

Test pre_immutable hook in tests

=item *

More tests fixme?

=back

=head1 BUGS

Probably plenty, test suite certainly isn't comprehensive.. Patches welcome.

=head1 AUTHOR

Tomas Doran (t0m) <bobtfish@bobtfish.net>

=head1 LICENSE

This code is copyright (c) 2009 Tomas Doran. This code is licensed on the same terms as perl
itself.

=cut