Everything works, with my uber hack of making the attribute bits a
Dave Rolsky [Fri, 5 Sep 2008 13:57:51 +0000 (13:57 +0000)]
role rather than a class.

lib/MooseX/ClassAttribute.pm
lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm [moved from lib/MooseX/ClassAttribute/Meta/Attribute.pm with 62% similarity]
lib/MooseX/ClassAttribute/Role/Meta/Class.pm

index ba5e4bb..fd5b3f9 100644 (file)
@@ -9,6 +9,7 @@ our $AUTHORITY = 'cpan:DROLSKY';
 use Moose ();
 use Moose::Exporter;
 use MooseX::ClassAttribute::Role::Meta::Class;
+use MooseX::ClassAttribute::Role::Meta::Attribute;
 
 Moose::Exporter->setup_import_methods
     ( with_caller => [ 'class_has' ] );
@@ -1,19 +1,25 @@
-package MooseX::ClassAttribute::Meta::Attribute;
+package MooseX::ClassAttribute::Role::Meta::Attribute;
 
 use strict;
 use warnings;
 
 use MooseX::ClassAttribute::Meta::Method::Accessor;
 
-use Moose;
+use Moose::Role;
 
-extends 'Moose::Meta::Attribute';
+# This is the worst role evar! Really, this should be a subclass,
+# because it overrides a lot of behavior. However, as a subclass it
+# won't cooperate with _other_ subclasses like
+# MX::AttributeHelpers::Base.
 
+around 'accessor_metaclass' => sub
+{
+    return 'MooseX::ClassAttribute::Meta::Method::Accessor';
+};
 
-sub accessor_metaclass { 'MooseX::ClassAttribute::Meta::Method::Accessor' }
-
-sub _process_options
+around '_process_options' => sub
 {
+    my $orig    = shift;
     my $class   = shift;
     my $name    = shift;
     my $options = shift;
@@ -21,29 +27,31 @@ sub _process_options
     confess 'A class attribute cannot be required'
         if $options->{required};
 
-    return $class->SUPER::_process_options( $name, $options );
-}
+    return $class->$orig( $name, $options );
+};
 
-sub attach_to_class
+around attach_to_class => sub
 {
+    my $orig = shift;
     my $self = shift;
     my $meta = shift;
 
-    $self->SUPER::attach_to_class($meta);
+    $self->$orig($meta);
 
     $self->_initialize($meta)
         unless $self->is_lazy();
-}
+};
 
-sub detach_from_class
+around 'detach_from_class' => sub
 {
+    my $orig = shift;
     my $self = shift;
     my $meta = shift;
 
     $self->clear_value($meta);
 
-    $self->SUPER::detach_from_class($meta);
-}
+    $self->$orig($meta);
+};
 
 sub _initialize
 {
@@ -59,11 +67,12 @@ sub _initialize
     }
 }
 
-sub default
+around 'default' => sub
 {
+    my $orig = shift;
     my $self = shift;
 
-    my $default = $self->SUPER::default();
+    my $default = $self->$orig();
 
     if ( $self->is_default_a_coderef() )
     {
@@ -71,10 +80,11 @@ sub default
     }
 
     return $default;
-}
+};
 
-sub _call_builder
+around '_call_builder' => sub
 {
+    shift;
     my $self  = shift;
     my $class = shift;
 
@@ -88,37 +98,41 @@ sub _call_builder
             . "' for attribute '"
             . $self->name
             . "'" );
-}
+};
 
-sub set_value
+around 'set_value' => sub
 {
+    shift;
     my $self  = shift;
     my $value = shift;
 
     $self->associated_class()->set_class_attribute_value( $self->name() => $value );
-}
+};
 
-sub get_value
+around 'get_value' => sub
 {
+    shift;
     my $self  = shift;
 
     return $self->associated_class()->get_class_attribute_value( $self->name() );
-}
+};
 
-sub has_value
+around 'has_value' => sub
 {
+    shift;
     my $self  = shift;
 
     return $self->associated_class()->has_class_attribute_value( $self->name() );
-}
+};
 
-sub clear_value
+around 'clear_value' => sub
 {
+    shift;
     my $self  = shift;
 
     return $self->associated_class()->clear_class_attribute_value( $self->name() );
-}
+};
 
-no Moose;
+no Moose::Role;
 
 1;
index e486b00..17c7fec 100644 (file)
@@ -12,7 +12,7 @@ use Moose::Role;
 has class_attribute_map =>
     ( metaclass => 'Collection::Hash',
       is        => 'ro',
-      isa       => 'HashRef[MooseX::ClassAttribute::Meta::Attribute]',
+      isa       => 'HashRef[Moose::Meta::Attribute]',
       provides  => { set    => '_add_class_attribute',
                      exists => 'has_class_attribute',
                      get    => 'get_class_attribute',
@@ -93,17 +93,13 @@ sub _process_new_class_attribute
     my $name = shift;
     my %p    = @_;
 
-    if ( $p{metaclass} )
+    if ( $p{traits} )
     {
-        $p{metaclass} =
-            Moose::Meta::Class->create_anon_class
-                ( superclasses => [ 'MooseX::ClassAttribute::Meta::Attribute', $p{metaclass} ],
-                  cache        => 1,
-                )->name();
+        push @{ $p{traits} },'MooseX::ClassAttribute::Role::Meta::Attribute'
     }
     else
     {
-        $p{metaclass} = 'MooseX::ClassAttribute::Meta::Attribute';
+        $p{traits} = [ 'MooseX::ClassAttribute::Role::Meta::Attribute' ];
     }
 
     return Moose::Meta::Attribute->interpolate_class_and_new( $name, %p );