From: Scott McWhirter <scott+github@konobi.co.uk>
Date: Fri, 26 Jun 2009 04:33:00 +0000 (+0100)
Subject: Add split out Accessor method and remove some small previous details
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=be94e76a2e64e4b8c7ed54c3b27fa98cbb2cff81;p=gitmo%2FClass-MOP.git

Add split out Accessor method and remove some small previous details
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 859fa4f..222db46 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -603,12 +603,6 @@ Class::MOP::Method::Attribute->meta->add_attribute(
     ))
 );
 
-Class::MOP::Method::Attribute->meta->add_attribute(
-    Class::MOP::Attribute->new('accessor_type' => (
-        reader   => { 'accessor_type' => \&Class::MOP::Method::Attribute::accessor_type },
-    ))
-);
-
 ## --------------------------------------------------------
 ## Class::MOP::Method::Constructor
 
diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index ec2d0c0..cec50d6 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -386,6 +386,7 @@ sub method_metaclasses {
         writer => 'Class::MOP::Method::Writer',
         predicate => 'Class::MOP::Method::Predicate',
         clearer => 'Class::MOP::Method::Clearer',
+        accessor => 'Class::MOP::Method::Accessor',
     }
 }
 
@@ -424,12 +425,11 @@ sub _process_accessors {
                 $method_ctx->{description} = $desc;
             }
 
-            my $method_metaclass = $self->method_metaclasses->{$type} || $self->accessor_metaclass;
+            my $method_metaclass = $self->method_metaclasses->{$type};
 
             $method = $method_metaclass->new(
                 attribute     => $self,
                 is_inline     => $inline_me,
-                accessor_type => $type,
                 package_name  => $self->associated_class->name,
                 name          => $accessor,
                 definition_context => $method_ctx,
diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm
index ad5c90a..c36026c 100644
--- a/lib/Class/MOP/Method/Accessor.pm
+++ b/lib/Class/MOP/Method/Accessor.pm
@@ -18,7 +18,6 @@ sub _initialize_body {
 
     my $method_name = join "_" => (
         '_generate',
-        $self->accessor_type,
         'method',
         ($self->is_inline ? 'inline' : ())
     );
@@ -28,47 +27,29 @@ sub _initialize_body {
 
 ## generators
 
-sub _generate_accessor_method {
-    my $attr = (shift)->associated_attribute;
-    return sub {
-        $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
-        $attr->get_value($_[0]);
-    };
+sub generate_method {
+    Carp::cluck('The generate_accessor_method method has been made private.'
+        . " The public version is deprecated and will be removed in a future release.\n");
+    shift->_generate_method;
 }
 
-sub _generate_reader_method {
+sub _generate_method {
     my $attr = (shift)->associated_attribute;
     return sub {
-        confess "Cannot assign a value to a read-only accessor" if @_ > 1;
+        $attr->set_value($_[0], $_[1]) if scalar(@_) == 2;
         $attr->get_value($_[0]);
     };
 }
 
+## Inline methods
 
-sub _generate_writer_method {
-    my $attr = (shift)->associated_attribute;
-    return sub {
-        $attr->set_value($_[0], $_[1]);
-    };
-}
-
-sub _generate_predicate_method {
-    my $attr = (shift)->associated_attribute;
-    return sub {
-        $attr->has_value($_[0])
-    };
-}
-
-sub _generate_clearer_method {
-    my $attr = (shift)->associated_attribute;
-    return sub {
-        $attr->clear_value($_[0])
-    };
+sub generate_method_inline {
+    Carp::cluck('The generate_accessor_method_inline method has been made private.'
+        . " The public version is deprecated and will be removed in a future release.\n");
+    shift->_generate_method_inline;
 }
 
-## Inline methods
-
-sub _generate_accessor_method_inline {
+sub _generate_method_inline {
     my $self          = shift;
     my $attr          = $self->associated_attribute;
     my $attr_name     = $attr->name;
@@ -87,75 +68,6 @@ sub _generate_accessor_method_inline {
     return $code;
 }
 
-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 ( $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 "Could not generate inline reader because : $e" if $e;
-
-    return $code;
-}
-
-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 ( $code, $e ) = $self->_eval_closure(
-        {},
-        'sub {'
-        . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
-        . '}'
-    );
-    confess "Could not generate inline writer because : $e" if $e;
-
-    return $code;
-}
-
-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 ( $code, $e ) = $self->_eval_closure(
-        {},
-       'sub {'
-       . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name)
-       . '}'
-    );
-    confess "Could not generate inline predicate because : $e" if $e;
-
-    return $code;
-}
-
-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 ( $code, $e ) = $self->_eval_closure(
-        {},
-        'sub {'
-        . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name)
-        . '}'
-    );
-    confess "Could not generate inline clearer because : $e" if $e;
-
-    return $code;
-}
-
 1;
 
 # XXX - UPDATE DOCS
diff --git a/lib/Class/MOP/Method/Attribute.pm b/lib/Class/MOP/Method/Attribute.pm
index 35c6ad1..468d526 100644
--- a/lib/Class/MOP/Method/Attribute.pm
+++ b/lib/Class/MOP/Method/Attribute.pm
@@ -48,7 +48,6 @@ sub _new {
 ## accessors
 
 sub associated_attribute { (shift)->{'attribute'}     }
-sub accessor_type        { (shift)->{'accessor_type'} }
 
 ## factory