From: Dave Rolsky Date: Fri, 5 Sep 2008 13:57:51 +0000 (+0000) Subject: Everything works, with my uber hack of making the attribute bits a X-Git-Tag: 0.05~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a1ec1ff1e2b1e9418b4b954d62ef50cec49d7b48;p=gitmo%2FMooseX-ClassAttribute.git Everything works, with my uber hack of making the attribute bits a role rather than a class. --- diff --git a/lib/MooseX/ClassAttribute.pm b/lib/MooseX/ClassAttribute.pm index ba5e4bb..fd5b3f9 100644 --- a/lib/MooseX/ClassAttribute.pm +++ b/lib/MooseX/ClassAttribute.pm @@ -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' ] ); diff --git a/lib/MooseX/ClassAttribute/Meta/Attribute.pm b/lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm similarity index 62% rename from lib/MooseX/ClassAttribute/Meta/Attribute.pm rename to lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm index c6fe316..06e97d6 100644 --- a/lib/MooseX/ClassAttribute/Meta/Attribute.pm +++ b/lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm @@ -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; diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Class.pm b/lib/MooseX/ClassAttribute/Role/Meta/Class.pm index e486b00..17c7fec 100644 --- a/lib/MooseX/ClassAttribute/Role/Meta/Class.pm +++ b/lib/MooseX/ClassAttribute/Role/Meta/Class.pm @@ -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 );