use strict;
use warnings;
-our $VERSION = '0.11';
-
-use MooseX::ClassAttribute::Meta::Method::Accessor;
-
use namespace::autoclean;
use Moose::Role;
# because it overrides a lot of behavior. However, as a subclass it
# won't cooperate with _other_ subclasses.
-around 'accessor_metaclass' => sub {
- return 'MooseX::ClassAttribute::Meta::Method::Accessor';
-};
-
around '_process_options' => sub {
my $orig = shift;
my $class = shift;
return $class->$orig( $name, $options );
};
-around attach_to_class => sub {
+around 'attach_to_class' => sub {
my $orig = shift;
my $self = shift;
my $meta = shift;
$self->$orig($meta);
-
- $self->_initialize($meta)
- unless $self->is_lazy();
+ $self->initialize_instance_slot($meta, $meta->name);
};
-around 'detach_from_class' => sub {
- my $orig = shift;
- my $self = shift;
- my $meta = shift;
-
- $self->clear_value($meta);
-
- $self->$orig($meta);
+override set_initial_value => sub {
+ my ($self, $instance, $value) = @_;
+ $self->_set_initial_slot_value(
+ $self,
+ $instance,
+ $value
+ );
};
-sub _initialize {
- my $self = shift;
- my $metaclass = shift;
-
- if ( $self->has_default() ) {
- $self->set_value( undef, $self->default() );
- }
- elsif ( $self->has_builder() ) {
- $self->set_value( undef, $self->_call_builder( $metaclass->name() ) );
- }
-}
-
-around 'default' => sub {
- my $orig = shift;
- my $self = shift;
-
- my $default = $self->$orig();
- if ( $self->is_default_a_coderef() ) {
- return $default->( $self->associated_class() );
- }
-
- return $default;
+before 'detach_from_class' => sub {
+ shift->clear_value(shift);
};
-around '_call_builder' => sub {
- shift;
- my $self = shift;
- my $class = shift;
-
- my $builder = $self->builder();
-
- return $class->$builder()
- if $class->can( $self->builder );
-
- confess( "$class does not support builder method '"
- . $self->builder
- . "' for attribute '"
- . $self->name
- . "'" );
-};
+sub set_slot_value { $_[0]->set_value($_[0], $_[3]) }
around 'set_value' => sub {
shift;
my $self = shift;
shift; # ignoring instance or class name
my $value = shift;
-
$self->associated_class()
->set_class_attribute_value( $self->name() => $value );
};
->clear_class_attribute_value( $self->name() );
};
+
+sub _inline_instance_get {}
+sub inline_get {}
+around ['inline_get', '_inline_instance_get'] => sub {
+ my ($orig, $self) = @_;
+
+ return $self->associated_class()
+ ->inline_get_class_slot_value( $self->slots() );
+};
+
+sub _inline_weaken_value {}
+around ['_inline_weaken_value'] => sub {
+ my ($orig, $self, $instance, $value) = @_;
+ return '' unless $self->is_weak_ref;
+ return
+ $self->associated_class->inline_weaken_class_slot_value( $self->slots() )
+ . 'if ref ' . $value . ';';
+};
+
+sub _inline_instance_set {}
+around ['_inline_instance_set'] => sub {
+ my ($orig, $self, undef, $value) = @_;
+
+ my $meta = $self->associated_class();
+
+ my $code
+ = $meta->inline_set_class_slot_value( $self->slots(), $value ) . ";";
+
+ return $code;
+};
+
+sub inline_set {}
+around ['inline_set'] => sub {
+ my ($orig, $self, undef, $value) = @_;
+
+ my $meta = $self->associated_class();
+
+ my $code
+ = $meta->inline_set_class_slot_value( $self->slots(), $value ) . ";";
+ $code
+ .= $self->_inline_weaken_value( $self->slots(), $value );
+
+ return $code;
+};
+
+sub _inline_instance_has {}
+sub inline_has {}
+around ['inline_has', '_inline_instance_has'] => sub {
+ my ($orig, $self) = @_;
+
+ return $self->associated_class()
+ ->inline_is_class_slot_initialized( $self->slots() );
+};
+
+sub _inline_clear_value {}
+sub inline_clear {}
+around ['inline_clear', '_inline_clear_value'] => sub {
+ my ($orig, $self) = @_;
+
+ return $self->associated_class()
+ ->inline_deinitialize_class_slot( $self->slots() );
+};
+
1;
+# ABSTRACT: A trait for class attributes
+
__END__
=pod
-=head1 NAME
-
-MooseX::ClassAttribute::Trait::Attribute - A trait for class attributes
-
=head1 DESCRIPTION
This role modifies the behavior of class attributes in various
There are no new public methods implemented by this role. All it does
is change the behavior of a number of existing methods.
-=head1 AUTHOR
-
-Dave Rolsky, C<< <autarch@urth.org> >>
-
=head1 BUGS
See L<MooseX::ClassAttribute> for details.
-=head1 COPYRIGHT & LICENSE
-
-Copyright 2007-2008 Dave Rolsky, All Rights Reserved.
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
=cut