From: t0m <bobtfish@bobtfish.net>
Date: Sun, 24 May 2009 22:28:56 +0000 (+0100)
Subject: Make the extended tests pass. This is now fairly frightning code ;)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ac8aab7d9e8ef9e9fc4852d0fc67a45219855b2d;hp=b20d38ca0f32d0ad5474d906ba5bda83ebf5f3b3;p=catagits%2FCatalystX-DynamicComponent.git

Make the extended tests pass. This is now fairly frightning code ;)
---

diff --git a/lib/CatalystX/DynamicComponent.pm b/lib/CatalystX/DynamicComponent.pm
index 8566aab..71e6fcb 100644
--- a/lib/CatalystX/DynamicComponent.pm
+++ b/lib/CatalystX/DynamicComponent.pm
@@ -1,8 +1,16 @@
 package CatalystX::DynamicComponent;
 use MooseX::Role::Parameterized;
-use MooseX::Types::Moose qw/Str CodeRef ArrayRef/;
+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' => (
@@ -15,11 +23,58 @@ parameter 'pre_immutable_hook' => (
     predicate => 'has_pre_immutable_hook',
 );
 
-parameter 'COMPONENT' => (
-    isa => CodeRef,
-    predicate => 'has_custom_component_method',
+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;
@@ -37,22 +92,19 @@ role {
 
         my $meta = Moose->init_meta( for_class => $name );
 
-        my @superclasses = @{ $config->{superclasses} || [] };
+        my @superclasses = @{ $get_resolved_config->('superclasses', $p, $config) };
         push(@superclasses, 'Catalyst::' . $type) unless @superclasses;
         $meta->superclasses(@superclasses);
 
-        if (my @roles = @{ $config->{roles}||[] }) {
+        if (my @roles = @{ $get_resolved_config->('roles', $p, $config) }) {
             Moose::Util::apply_all_roles( $name, @roles);
         }
 
-        if ($p->has_custom_component_method) {
-            $meta->add_method(COMPONENT => $p->COMPONENT);
-        }
-
         $app->$pre_immutable_hook($meta) if $p->has_pre_immutable_hook;
 
-        foreach my $name (keys %{ $config->{methods}||{} }) {
-            $meta->add_method($name => $config->{methods}->{$name});
+        my $methods = $get_resolved_config->('methods', $p, $config);
+        foreach my $name (keys %$methods) {
+            $meta->add_method($name => $methods->{$name});
         }
         $meta->make_immutable;
 
diff --git a/t/03_dynamiccomponent.t b/t/03_dynamiccomponent.t
index 7aea2d3..87f5953 100644
--- a/t/03_dynamiccomponent.t
+++ b/t/03_dynamiccomponent.t
@@ -102,7 +102,7 @@ my $extra_config = {
     ok $model->can('_some_method_from_role'), 'Has had role applied';
     ok !My::Model->can('_some_method_from_role'), 'Role applied at right place';
     
-    ok $model->can('_some_other_method_from_role'),
+    ok $model->can('_some_method_from_other_role'),
         'Role application merges by default';
 
     ok $model->can('my_injected_method'), 'Injected method there as expected';