From: Dave Rolsky <autarch@urth.org>
Date: Thu, 6 Dec 2007 22:11:25 +0000 (+0000)
Subject: Tweaks based on Stevan's changes to make greater use of the
X-Git-Tag: 0.04~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b4d972cdaa4e3cd41ce3b0b81331bba3818de5ec;p=gitmo%2FMooseX-ClassAttribute.git

Tweaks based on Stevan's changes to make greater use of the
Moose/Class::MOP API and reduce the amount of string eval hackery.
---

diff --git a/lib/MooseX/ClassAttribute.pm b/lib/MooseX/ClassAttribute.pm
index 1980ce7..8a0c4a2 100644
--- a/lib/MooseX/ClassAttribute.pm
+++ b/lib/MooseX/ClassAttribute.pm
@@ -23,8 +23,7 @@ sub class_has ## no critic RequireArgUnpacking
 
     my $container_pkg = _make_container_class( $caller, @parents );
 
-    my $has = $container_pkg->can('has');
-    $has->(@_);
+    $container_pkg->meta()->_process_attribute(@_);
 
     my $container_meta = $container_pkg->meta();
     for my $meth ( grep { $_ ne 'instance' } $container_meta->get_method_list() )
@@ -56,28 +55,22 @@ sub class_has ## no critic RequireArgUnpacking
 
         my @parents = map { container_class($_) || () } @_;
 
-        my $container_pkg = 'MooseX::ClassAttribute::Container::' . $caller;
-
-        my $code = "package $container_pkg;\n";
-        $code .= "use Moose;\n\n";
-
-        if (@parents)
-        {
-            $code .= "extends qw( @parents );\n";
-        }
-
-        $code .= <<'EOF';
-
-my $Self;
-sub instance
-{
-    return $Self ||= shift->new(@_);
-}
-EOF
+        push @parents, 'Moose::Object'
+            unless grep { $_->isa('Moose::Object') } @parents;
 
+        my $container_pkg = 'MooseX::ClassAttribute::Container::' . $caller;
 
-        eval $code; ## no critic ProhibitStringyEval
-        die $@ if $@;
+        my $instance_meth = sub {
+            no strict 'refs'; ## no critic ProhibitNoStrict
+            return ${ $container_pkg . '::Self' } ||= shift->new(@_);
+        };
+
+        my $class =
+            Moose::Meta::Class->create
+                ( $container_pkg =>
+                  superclasses => \@parents,
+                  methods      => { instance => $instance_meth },
+                );
 
         return $Name{$caller} = $container_pkg;
     }