Implement inlining code in CMOP::Attribute

This can mostly be reused in Moose, and ensures all attributes have a consistent API

diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index 1bb7464..cf1aafe 100644 (file)
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -404,6 +404,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__
@@ -894,6 +928,18 @@ attribute.
 This does not currently remove methods from the list returned by
 C<associated_methods>.
 
+=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

diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index 32c484e..94b0fe1 100644 (file)
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -130,18 +130,15 @@ sub _generate_clearer_method {
 ## Inline methods
 
 sub _generate_accessor_method_inline {
-    my $self          = shift;
-    my $attr          = $self->associated_attribute;
-    my $attr_name     = $attr->name;
-    my $meta_instance = $attr->associated_class->instance_metaclass;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
 
     my ( $code, $e ) = $self->_eval_closure(
         {},
         'sub {'
-        . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
-        . ' if scalar(@_) == 2; '
-        . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
-        . '}'
+            . $attr->inline_set( '$_[0]', '$_[1]' )
+            . ' if scalar(@_) == 2; '
+            . $attr->inline_get('$_[0]') . '}'
     );
     confess "Could not generate inline accessor because : $e" if $e;
 
@@ -149,17 +146,14 @@ sub _generate_accessor_method_inline {
 }
 
 sub _generate_reader_method_inline {
-    my $self          = shift;
-    my $attr          = $self->associated_attribute;
-    my $attr_name     = $attr->name;
-    my $meta_instance = $attr->associated_class->instance_metaclass;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
 
-     my ( $code, $e ) = $self->_eval_closure(
-         {},
+    my ( $code, $e ) = $self->_eval_closure(
+        {},
         'sub {'
-        . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
-        . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
-        . '}'
+            . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
+            . $attr->inline_get('$_[0]') . '}'
     );
     confess "Could not generate inline reader because : $e" if $e;
 
@@ -167,16 +161,12 @@ sub _generate_reader_method_inline {
 }
 
 sub _generate_writer_method_inline {
-    my $self          = shift;
-    my $attr          = $self->associated_attribute;
-    my $attr_name     = $attr->name;
-    my $meta_instance = $attr->associated_class->instance_metaclass;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
 
     my ( $code, $e ) = $self->_eval_closure(
         {},
-        'sub {'
-        . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
-        . '}'
+        'sub {' . $attr->inline_set( '$_[0]', '$_[1]' ) . '}'
     );
     confess "Could not generate inline writer because : $e" if $e;
 
@@ -184,16 +174,12 @@ sub _generate_writer_method_inline {
 }
 
 sub _generate_predicate_method_inline {
-    my $self          = shift;
-    my $attr          = $self->associated_attribute;
-    my $attr_name     = $attr->name;
-    my $meta_instance = $attr->associated_class->instance_metaclass;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
 
     my ( $code, $e ) = $self->_eval_closure(
         {},
-       'sub {'
-       . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name)
-       . '}'
+        'sub {' . $attr->inline_has('$_[0]') . '}'
     );
     confess "Could not generate inline predicate because : $e" if $e;
 
@@ -201,16 +187,12 @@ sub _generate_predicate_method_inline {
 }
 
 sub _generate_clearer_method_inline {
-    my $self          = shift;
-    my $attr          = $self->associated_attribute;
-    my $attr_name     = $attr->name;
-    my $meta_instance = $attr->associated_class->instance_metaclass;
+    my $self = shift;
+    my $attr = $self->associated_attribute;
 
     my ( $code, $e ) = $self->_eval_closure(
         {},
-        'sub {'
-        . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name)
-        . '}'
+        'sub {' . $attr->inline_clear('$_[0]') . '}'
     );
     confess "Could not generate inline clearer because : $e" if $e;
 

diff --git a/t/014_attribute_introspection.t b/t/014_attribute_introspection.t
index 25d52c6..7b77803 100644 (file)
--- a/t/014_attribute_introspection.t
+++ b/t/014_attribute_introspection.t
@@ -62,6 +62,11 @@ use Class::MOP;
         install_accessors
         remove_accessors
 
+        inline_get
+        inline_set
+        inline_has
+        inline_clear
+
         _new
     );