X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FClassAttribute%2FTrait%2FAttribute.pm;h=efd923cff155f41bbdbb2ff25d7e1907067b3b50;hb=3e9e5aef1aa4a05b64d7beddc49121775bec5320;hp=bd13ac1c4ddc0db8ff9b2a0c77e9e389679d8bdb;hpb=eeee5ccb10fe2f92415751b2f721a89798393c29;p=gitmo%2FMooseX-ClassAttribute.git diff --git a/lib/MooseX/ClassAttribute/Trait/Attribute.pm b/lib/MooseX/ClassAttribute/Trait/Attribute.pm index bd13ac1..efd923c 100644 --- a/lib/MooseX/ClassAttribute/Trait/Attribute.pm +++ b/lib/MooseX/ClassAttribute/Trait/Attribute.pm @@ -3,10 +3,6 @@ package MooseX::ClassAttribute::Trait::Attribute; use strict; use warnings; -our $VERSION = '0.12'; - -use MooseX::ClassAttribute::Meta::Method::Accessor; - use namespace::autoclean; use Moose::Role; @@ -14,11 +10,7 @@ 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 { +around _process_options => sub { my $orig = shift; my $class = shift; my $name = shift; @@ -30,25 +22,19 @@ around '_process_options' => sub { return $class->$orig( $name, $options ); }; -around attach_to_class => sub { - my $orig = shift; +after attach_to_class => sub { my $self = shift; my $meta = shift; - $self->$orig($meta); - $self->_initialize($meta) unless $self->is_lazy(); }; -around 'detach_from_class' => sub { - my $orig = shift; +before detach_from_class => sub { my $self = shift; my $meta = shift; $self->clear_value($meta); - - $self->$orig($meta); }; sub _initialize { @@ -56,27 +42,30 @@ sub _initialize { my $metaclass = shift; if ( $self->has_default() ) { - $self->set_value( undef, $self->default() ); + $self->set_value( + undef, + $self->default( $self->associated_class() ) + ); } elsif ( $self->has_builder() ) { $self->set_value( undef, $self->_call_builder( $metaclass->name() ) ); } } -around 'default' => sub { +around default => sub { my $orig = shift; my $self = shift; my $default = $self->$orig(); - if ( $self->is_default_a_coderef() ) { - return $default->( $self->associated_class() ); + if ( $self->is_default_a_coderef() && @_ ) { + return $default->(@_); } return $default; }; -around '_call_builder' => sub { +around _call_builder => sub { shift; my $self = shift; my $class = shift; @@ -93,7 +82,7 @@ around '_call_builder' => sub { . "'" ); }; -around 'set_value' => sub { +around set_value => sub { shift; my $self = shift; shift; # ignoring instance or class name @@ -103,7 +92,7 @@ around 'set_value' => sub { ->set_class_attribute_value( $self->name() => $value ); }; -around 'get_value' => sub { +around get_value => sub { shift; my $self = shift; @@ -111,7 +100,7 @@ around 'get_value' => sub { ->get_class_attribute_value( $self->name() ); }; -around 'has_value' => sub { +around has_value => sub { shift; my $self = shift; @@ -119,7 +108,7 @@ around 'has_value' => sub { ->has_class_attribute_value( $self->name() ); }; -around 'clear_value' => sub { +around clear_value => sub { shift; my $self = shift; @@ -127,16 +116,112 @@ around 'clear_value' => sub { ->clear_class_attribute_value( $self->name() ); }; +if ( $Moose::VERSION < 1.99 ) { + around inline_get => sub { + shift; + my $self = shift; + + return $self->associated_class() + ->_inline_get_class_slot_value( $self->slots() ); + }; + + around inline_set => sub { + shift; + my $self = shift; + shift; + my $value = shift; + + my $meta = $self->associated_class(); + + my $code + = $meta->_inline_set_class_slot_value( $self->slots(), $value ) + . ";"; + $code .= $meta->_inline_weaken_class_slot_value( + $self->slots(), + $value + ) + . " if ref $value;" + if $self->is_weak_ref(); + + return $code; + }; + + around inline_has => sub { + shift; + my $self = shift; + + return $self->associated_class() + ->_inline_is_class_slot_initialized( $self->slots() ); + }; + + around inline_clear => sub { + shift; + my $self = shift; + + return $self->associated_class() + ->_inline_deinitialize_class_slot( $self->slots() ); + }; +} +else { + around _inline_instance_get => sub { + shift; + my $self = shift; + + return $self->associated_class() + ->_inline_get_class_slot_value( $self->slots() ); + }; + + around _inline_instance_set => sub { + shift; + my $self = shift; + shift; + my $value = shift; + + return $self->associated_class() + ->_inline_set_class_slot_value( $self->slots(), $value ); + }; + + around _inline_instance_has => sub { + shift; + my $self = shift; + + return $self->associated_class() + ->_inline_is_class_slot_initialized( $self->slots() ); + }; + + around _inline_instance_clear => sub { + shift; + my $self = shift; + + return $self->associated_class() + ->_inline_deinitialize_class_slot( $self->slots() ); + }; + + around _inline_weaken_value => sub { + shift; + my $self = shift; + shift; + my $value = shift; + + return unless $self->is_weak_ref(); + + return ( + $self->associated_class->_inline_weaken_class_slot_value( + $self->slots(), $value + ), + 'if ref ' . $value . ';', + ); + }; +} + 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 @@ -147,19 +232,8 @@ metaclasses, like C. 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<< >> - =head1 BUGS See L for details. -=head1 COPYRIGHT & LICENSE - -Copyright 2007-2010 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