From: Stevan Little Date: Mon, 1 May 2006 19:33:27 +0000 (+0000) Subject: stuff X-Git-Tag: 0_29_02~20 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=005adf8fe9f261dc26550cb81fa8319cb91e5313;p=gitmo%2FClass-MOP.git stuff --- diff --git a/examples/InsideOutClass.pod b/examples/InsideOutClass.pod index 8466b76..b0f805f 100644 --- a/examples/InsideOutClass.pod +++ b/examples/InsideOutClass.pod @@ -40,6 +40,12 @@ sub is_slot_initialized { return exists $self->{meta}->get_package_variable('%' . $slot_name)->{refaddr $instance} ? 1 : 0; } +sub inline_slot_access { + my ($self, $instance, $slot_name) = @_; + $slot_name =~ s/\'//g; + ('$' . $self->{meta}->name . '::' . $slot_name . '{Scalar::Util::refaddr(' . $instance . ')}'); +} + 1; __END__ @@ -92,9 +98,7 @@ an exercise to the reader. Stevan Little Estevan@iinteractive.comE -=head1 SEE ALSO - -L +Yuval Kogman Enothingmuch@woobling.comE =head1 COPYRIGHT AND LICENSE diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index b85a8a2..c05aa2d 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -134,44 +134,81 @@ sub detach_from_class { sub generate_accessor_method { my $self = shift; - my $meta_class = $self->associated_class; + #my $meta_class = $self->associated_class; + my $meta_instance = $self->associated_class->get_meta_instance; my $attr_name = $self->name; - return sub { - my $meta_instance = $meta_class->get_meta_instance; - $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2; - $meta_instance->get_slot_value($_[0], $attr_name); - }; + #return sub { + # my $meta_instance = $meta_class->get_meta_instance; + # $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2; + # $meta_instance->get_slot_value($_[0], $attr_name); + #}; + + my $code = "sub {\n" + . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') + . " if scalar(\@_) == 2;\n" + . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'", '$_[1]') + . "\n}"; + my $sub = eval $code; + confess "Could not eval code:\n$code\nbecause: $@" if $@; + return $sub; } sub generate_reader_method { my $self = shift; - my $meta_class = $self->associated_class; + #my $meta_class = $self->associated_class; + my $meta_instance = $self->associated_class->get_meta_instance; my $attr_name = $self->name; - return sub { - confess "Cannot assign a value to a read-only accessor" if @_ > 1; - $meta_class->get_meta_instance - ->get_slot_value($_[0], $attr_name); - }; + #return sub { + # confess "Cannot assign a value to a read-only accessor" if @_ > 1; + # $meta_class->get_meta_instance + # ->get_slot_value($_[0], $attr_name); + #}; + + my $code = "sub {\n" + . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;' . "\n" + . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'", '$_[1]') + . "\n}"; + my $sub = eval $code; + confess "Could not eval code:\n$code\nbecause: $@" if $@; + return $sub; } sub generate_writer_method { my $self = shift; - my $meta_class = $self->associated_class; + #my $meta_class = $self->associated_class; + my $meta_instance = $self->associated_class->get_meta_instance; my $attr_name = $self->name; - return sub { - $meta_class->get_meta_instance - ->set_slot_value($_[0], $attr_name, $_[1]); - }; + #return sub { + # $meta_class->get_meta_instance + # ->set_slot_value($_[0], $attr_name, $_[1]); + #}; + + my $code = "sub {\n" + . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') + . "\n}"; + my $sub = eval $code; + confess "Could not eval code:\n$code\nbecause: $@" if $@; + return $sub; } sub generate_predicate_method { my $self = shift; - my $meta_class = $self->associated_class; + #my $meta_class = $self->associated_class; + my $meta_instance = $self->associated_class->get_meta_instance; my $attr_name = $self->name; - return sub { - defined $meta_class->get_meta_instance - ->get_slot_value($_[0], $attr_name) ? 1 : 0; - }; + #return sub { + # defined $meta_class->get_meta_instance + # ->get_slot_value($_[0], $attr_name) ? 1 : 0; + #}; + + my $code = "sub {\n" + . 'defined ' + . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'", '$_[1]') + . ' ? 1 : 0;' + . "\n}"; + my $sub = eval $code; + confess "Could not eval code:\n$code\nbecause: $@" if $@; + return $sub; } sub process_accessors {