X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FAttribute.pm;h=d0cf23477fb3303c46e2485343b544e59b7d4c1b;hb=53362bcb1b32d87630190fbf50679dc37bb51adf;hp=e5208289a8a5febd4778e0fdf1c8895823af1569;hpb=e00524a03329f89358767302ffc62cd15ec33571;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index e520828..d0cf234 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -8,12 +8,13 @@ use Class::MOP::Method::Accessor; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; +use Try::Tiny; -our $VERSION = '0.83'; +our $VERSION = '1.11'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use base 'Class::MOP::Object'; +use base 'Class::MOP::Object', 'Class::MOP::Mixin::AttributeCore'; # NOTE: (meta-circularity) # This method will be replaced in the @@ -32,7 +33,7 @@ sub new { my $name = $options{name}; - (defined $name && $name) + (defined $name) || confess "You must provide a name for the attribute"; $options{init_arg} = $name @@ -43,7 +44,7 @@ sub new { confess("Setting both default and builder is not allowed.") if exists $options{default}; } else { - (is_default_a_coderef(\%options)) + ($class->is_default_a_coderef(\%options)) || confess("References are not allowed as default values, you must ". "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])") if exists $options{default} && ref $options{default}; @@ -57,6 +58,10 @@ sub new { sub _new { my $class = shift; + + return Class::MOP::Class->initialize($class)->new_object(@_) + if $class ne __PACKAGE__; + my $options = @_ == 1 ? $_[0] : {@_}; bless { @@ -68,7 +73,9 @@ sub _new { 'clearer' => $options->{clearer}, 'builder' => $options->{builder}, 'init_arg' => $options->{init_arg}, - 'default' => $options->{default}, + exists $options->{default} + ? ('default' => $options->{default}) + : (), 'initializer' => $options->{initializer}, 'definition_context' => $options->{definition_context}, # keep a weakened link to the @@ -77,6 +84,10 @@ sub _new { # and a list of the methods # associated with this attr 'associated_methods' => [], + # this let's us keep track of + # our order inside the associated + # class + 'insertion_order' => undef, }, $class; } @@ -108,7 +119,7 @@ sub initialize_instance_slot { $params->{$init_arg}, ); } - elsif (defined $self->{'default'}) { + elsif (exists $self->{'default'}) { $self->_set_initial_slot_value( $meta_instance, $instance, @@ -147,39 +158,6 @@ sub _set_initial_slot_value { $instance->$initializer($value, $callback, $self); } -# NOTE: -# the next bunch of methods will get bootstrapped -# away in the Class::MOP bootstrapping section - -sub associated_class { $_[0]->{'associated_class'} } -sub associated_methods { $_[0]->{'associated_methods'} } - -sub has_accessor { defined($_[0]->{'accessor'}) } -sub has_reader { defined($_[0]->{'reader'}) } -sub has_writer { defined($_[0]->{'writer'}) } -sub has_predicate { defined($_[0]->{'predicate'}) } -sub has_clearer { defined($_[0]->{'clearer'}) } -sub has_builder { defined($_[0]->{'builder'}) } -sub has_init_arg { defined($_[0]->{'init_arg'}) } -sub has_default { defined($_[0]->{'default'}) } -sub has_initializer { defined($_[0]->{'initializer'}) } - -sub accessor { $_[0]->{'accessor'} } -sub reader { $_[0]->{'reader'} } -sub writer { $_[0]->{'writer'} } -sub predicate { $_[0]->{'predicate'} } -sub clearer { $_[0]->{'clearer'} } -sub builder { $_[0]->{'builder'} } -sub init_arg { $_[0]->{'init_arg'} } -sub initializer { $_[0]->{'initializer'} } -sub definition_context { $_[0]->{'definition_context'} } - -# end bootstrapped away method section. -# (all methods below here are kept intact) - -sub has_read_method { $_[0]->has_reader || $_[0]->has_accessor } -sub has_write_method { $_[0]->has_writer || $_[0]->has_accessor } - sub get_read_method { my $self = shift; my $reader = $self->reader || $self->accessor; @@ -240,22 +218,6 @@ sub get_write_method_ref { } } -sub is_default_a_coderef { - ('CODE' eq ref($_[0]->{'default'})) -} - -sub default { - my ($self, $instance) = @_; - if (defined $instance && $self->is_default_a_coderef) { - # if the default is a CODE ref, then - # we pass in the instance and default - # can return a value based on that - # instance. Somewhat crude, but works. - return $self->{'default'}->($instance); - } - $self->{'default'}; -} - # slots sub slots { (shift)->name } @@ -292,7 +254,10 @@ sub set_initial_value { ); } -sub set_value { +sub set_value { shift->set_raw_value(@_) } +sub get_value { shift->get_raw_value(@_) } + +sub set_raw_value { my ($self, $instance, $value) = @_; Class::MOP::Class->initialize(ref($instance)) @@ -300,7 +265,7 @@ sub set_value { ->set_slot_value($instance, $self->name, $value); } -sub get_value { +sub get_raw_value { my ($self, $instance) = @_; Class::MOP::Class->initialize(ref($instance)) @@ -328,12 +293,6 @@ sub clear_value { sub accessor_metaclass { 'Class::MOP::Method::Accessor' } -sub process_accessors { - Carp::cluck('The process_accessors method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_process_accessors(@_); -} - sub _process_accessors { my ($self, $type, $accessor, $generate_as_inline_methods) = @_; @@ -359,7 +318,7 @@ sub _process_accessors { else { my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable); my $method; - eval { + try { if ( $method_ctx ) { my $desc = "accessor $accessor"; if ( $accessor ne $self->name ) { @@ -377,8 +336,10 @@ sub _process_accessors { name => $accessor, definition_context => $method_ctx, ); + } + catch { + confess "Could not create the '$type' method for " . $self->name . " because : $_"; }; - confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@; $self->associate_method($method); return ($accessor, $method); } @@ -440,6 +401,40 @@ sub install_accessors { } +sub inline_get { + my $self = shift; + my ($instance) = @_; + + return $self->associated_class->get_meta_instance->inline_get_slot_value( + $instance, $self->name ); +} + +sub inline_set { + my $self = shift; + my ( $instance, $value ) = @_; + + return $self->associated_class->get_meta_instance->inline_set_slot_value( + $instance, $self->name, $value ); +} + +sub inline_has { + my $self = shift; + my ($instance) = @_; + + return + $self->associated_class->get_meta_instance + ->inline_is_slot_initialized( $instance, $self->name ); +} + +sub inline_clear { + my $self = shift; + my ($instance) = @_; + + return + $self->associated_class->get_meta_instance + ->inline_deinitialize_slot( $instance, $self->name ); +} + 1; __END__ @@ -584,7 +579,7 @@ twice the given value. Class::MOP::Attribute->new( 'doubled' => ( initializer => sub { - my ( $instance, $value, $set ) = @_; + my ( $self, $value, $set, $attr ) = @_; $set->( $value * 2 ); }, ) @@ -753,6 +748,11 @@ writing the attribute's value in the associated class. These methods always return a subroutine reference, regardless of whether or not the attribute is read- or write-only. +=item B<< $attr->insertion_order >> + +If this attribute has been inserted into a class, this returns a zero +based index regarding the order of insertion. + =back =head2 Informational predicates @@ -784,6 +784,10 @@ C is the default C anyway. =item B<< $attr->has_builder >> +=item B<< $attr->has_insertion_order >> + +This will be I if this attribute has not be inserted into a class + =back =head2 Value management @@ -811,6 +815,12 @@ It's unlikely that you'll need to call this method yourself. Sets the value without going through the accessor. Note that this works even with read-only attributes. +=item B<< $attr->set_raw_value($instance, $value) >> + +Sets the value with no side effects such as a trigger. + +This doesn't actually apply to Class::MOP attributes, only to subclasses. + =item B<< $attr->set_initial_value($instance, $value) >> Sets the value without going through the accessor. This method is only @@ -821,6 +831,12 @@ called when the instance is first being initialized. Returns the value without going through the accessor. Note that this works even with write-only accessors. +=item B<< $attr->get_raw_value($instance) >> + +Returns the value without any side effects such as lazy attributes. + +Doesn't actually apply to Class::MOP attributes, only to subclasses. + =item B<< $attr->has_value($instance) >> Return a boolean indicating whether the attribute has been set in @@ -909,6 +925,18 @@ attribute. This does not currently remove methods from the list returned by C. +=item B<< $attr->inline_get >> + +=item B<< $attr->inline_set >> + +=item B<< $attr->inline_has >> + +=item B<< $attr->inline_clear >> + +These methods return a code snippet suitable for inlining the relevant +operation. They expect strings containing variable names to be used in the +inlining, like C<'$self'> or C<'$_[1]'>. + =back =head2 Introspection @@ -931,7 +959,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L