stuff
Stevan Little [Mon, 1 May 2006 19:33:27 +0000 (19:33 +0000)]
examples/InsideOutClass.pod
lib/Class/MOP/Attribute.pm

index 8466b76..b0f805f 100644 (file)
@@ -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 E<lt>stevan@iinteractive.comE<gt>
 
-=head1 SEE ALSO
-
-L<Tie::RefHash::Weak>
+Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
index b85a8a2..c05aa2d 100644 (file)
@@ -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 {