use strict;
use warnings;
-use MooseX::AttributeHelpers;
use MooseX::ClassAttribute::Role::Meta::Attribute;
use Scalar::Util qw( blessed );
+use namespace::autoclean;
use Moose::Role;
-
-has class_attribute_map =>
- ( metaclass => 'Collection::Hash',
- is => 'ro',
- isa => 'HashRef[Moose::Meta::Attribute]',
- provides => { set => '_add_class_attribute',
- exists => 'has_class_attribute',
- get => 'get_class_attribute',
- delete => '_remove_class_attribute',
- keys => 'get_class_attribute_list',
- },
- default => sub { {} },
- reader => 'get_class_attribute_map',
- );
-
-has _class_attribute_values =>
- ( metaclass => 'Collection::Hash',
- is => 'ro',
- isa => 'HashRef',
- provides => { get => 'get_class_attribute_value',
- set => 'set_class_attribute_value',
- exists => 'has_class_attribute_value',
- delete => 'clear_class_attribute_value',
- },
- lazy => 1,
- default => sub { $_[0]->_class_attribute_values_hashref() },
- );
-
-
-sub add_class_attribute
-{
+with 'MooseX::ClassAttribute::Role::Meta::Mixin::HasClassAttributes';
+
+has _class_attribute_values => (
+ traits => ['Hash'],
+ is => 'ro',
+ isa => 'HashRef',
+ handles => {
+ 'get_class_attribute_value' => 'get',
+ 'set_class_attribute_value' => 'set',
+ 'has_class_attribute_value' => 'exists',
+ 'clear_class_attribute_value' => 'delete',
+ },
+ lazy => 1,
+ default => sub { $_[0]->_class_attribute_values_hashref() },
+ init_arg => undef,
+);
+
+around add_class_attribute => sub {
+ my $orig = shift;
my $self = shift;
-
- my $attr =
+ my $attr = (
blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
? $_[0]
- : $self->_process_class_attribute(@_);
+ : $self->_process_class_attribute(@_)
+ );
- my $name = $attr->name();
+ $self->$orig($attr);
- $self->remove_class_attribute($name)
- if $self->has_class_attribute($name);
+ return $attr;
+};
- $attr->attach_to_class($self);
+sub _post_add_class_attribute {
+ my $self = shift;
+ my $attr = shift;
- $self->_add_class_attribute( $name => $attr );
+ my $name = $attr->name();
- my $e = do { local $@; eval { $attr->install_accessors() }; $@ };
+ my $e = do {
+ local $@;
+ eval { $attr->install_accessors() };
+ $@;
+ };
- if ( $e )
- {
+ if ($e) {
$self->remove_attribute($name);
die $e;
}
+}
- return $attr;
+sub _attach_class_attribute {
+ my ($self, $attribute) = @_;
+ $attribute->attach_to_class($self);
}
# It'd be nice if I didn't have to replicate this for class
# attributes, since it's basically just a copy of
# Moose::Meta::Class->_process_attribute
-sub _process_class_attribute
-{
+sub _process_class_attribute {
my $self = shift;
my $name = shift;
my @args = @_;
- @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
+ @args = %{ $args[0] } if scalar @args == 1 && ref( $args[0] ) eq 'HASH';
- if ($name =~ /^\+(.*)/)
- {
+ if ( $name =~ /^\+(.*)/ ) {
return $self->_process_inherited_class_attribute( $1, @args );
}
- else
- {
+ else {
return $self->_process_new_class_attribute( $name, @args );
}
}
-sub _process_new_class_attribute
-{
+sub _process_new_class_attribute {
my $self = shift;
my $name = shift;
my %p = @_;
- if ( $p{traits} )
- {
- push @{ $p{traits} },'MooseX::ClassAttribute::Role::Meta::Attribute'
+ if ( $p{traits} ) {
+ push @{ $p{traits} }, 'MooseX::ClassAttribute::Role::Meta::Attribute';
}
- else
- {
- $p{traits} = [ 'MooseX::ClassAttribute::Role::Meta::Attribute' ];
+ else {
+ $p{traits} = ['MooseX::ClassAttribute::Role::Meta::Attribute'];
}
return Moose::Meta::Attribute->interpolate_class_and_new( $name, %p );
}
-sub _process_inherited_class_attribute
-{
+sub _process_inherited_class_attribute {
my $self = shift;
my $name = shift;
my %p = @_;
my $inherited_attr = $self->find_class_attribute_by_name($name);
- (defined $inherited_attr)
- || confess "Could not find an attribute by the name of '$name' to inherit from";
+ ( defined $inherited_attr )
+ || confess
+ "Could not find an attribute by the name of '$name' to inherit from";
return $inherited_attr->clone_and_inherit_options(%p);
}
-sub remove_class_attribute
-{
+around remove_class_attribute => sub {
+ my $orig = shift;
my $self = shift;
- my $name = shift;
-
- (defined $name && $name)
- || confess 'You must provide an attribute name';
- my $removed_attr = $self->get_class_attribute($name);
- return unless $removed_attr;
-
- $self->_remove_class_attribute($name);
+ my $removed_attr = $self->$orig(@_)
+ or return;
$removed_attr->remove_accessors();
$removed_attr->detach_from_class();
return $removed_attr;
-}
+};
-sub get_all_class_attributes
-{
+sub get_all_class_attributes {
my $self = shift;
- my %attrs =
- map { my $meta = Class::MOP::class_of($_);
- $meta && $meta->can('get_class_attribute_map')
- ? %{ $meta->get_class_attribute_map() }
- : ()
- }
+ my %attrs
+ = map {
+ my $meta = Class::MOP::class_of($_);
+ $meta && $meta->can('get_class_attribute_map')
+ ? %{ $meta->get_class_attribute_map() }
+ : ()
+ }
reverse $self->linearized_isa;
return values %attrs;
}
-sub compute_all_applicable_class_attributes
-{
- warn 'The compute_all_applicable_class_attributes method has been deprecated.'
+sub compute_all_applicable_class_attributes {
+ warn
+ 'The compute_all_applicable_class_attributes method has been deprecated.'
. " Use get_all_class_attributes instead.\n";
shift->compute_all_applicable_class_attributes(@_);
}
-sub find_class_attribute_by_name
-{
+sub find_class_attribute_by_name {
my $self = shift;
my $name = shift;
- foreach my $class ( $self->linearized_isa() )
- {
+ foreach my $class ( $self->linearized_isa() ) {
my $meta = Class::MOP::class_of($class)
or next;
return $meta->get_class_attribute($name)
- if $meta->can('has_class_attribute') && $meta->has_class_attribute($name);
+ if $meta->can('has_class_attribute')
+ && $meta->has_class_attribute($name);
}
return;
}
-sub _class_attribute_values_hashref
-{
+sub _class_attribute_values_hashref {
my $self = shift;
no strict 'refs';
return \%{ $self->_class_attribute_var_name() };
}
-sub _class_attribute_var_name
-{
+sub _class_attribute_var_name {
my $self = shift;
return $self->name() . q'::__ClassAttributeValues';
}
-sub inline_class_slot_access
-{
+sub inline_class_slot_access {
my $self = shift;
my $name = shift;
- return '$' . $self->_class_attribute_var_name . '{"' . quotemeta($name) . '"}';
+ return
+ '$'
+ . $self->_class_attribute_var_name . '{"'
+ . quotemeta($name) . '"}';
}
-sub inline_get_class_slot_value
-{
+sub inline_get_class_slot_value {
my $self = shift;
my $name = shift;
return $self->inline_class_slot_access($name);
}
-sub inline_set_class_slot_value
-{
+sub inline_set_class_slot_value {
my $self = shift;
my $name = shift;
my $val_name = shift;
return $self->inline_class_slot_access($name) . ' = ' . $val_name;
}
-sub inline_is_class_slot_initialized
-{
- my $self = shift;
- my $name = shift;
+sub inline_is_class_slot_initialized {
+ my $self = shift;
+ my $name = shift;
return 'exists ' . $self->inline_class_slot_access($name);
}
-sub inline_deinitialize_class_slot
-{
- my $self = shift;
- my $name = shift;
+sub inline_deinitialize_class_slot {
+ my $self = shift;
+ my $name = shift;
return 'delete ' . $self->inline_class_slot_access($name);
}
-sub inline_weaken_class_slot_value
-{
- my $self = shift;
- my $name = shift;
+sub inline_weaken_class_slot_value {
+ my $self = shift;
+ my $name = shift;
- return 'Scalar::Util::weaken( ' . $self->inline_class_slot_access($name) . ')';
+ return
+ 'Scalar::Util::weaken( '
+ . $self->inline_class_slot_access($name) . ')';
}
-no Moose::Role;
-
1;
__END__