From: gfx <gfuji@cpan.org>
Date: Sat, 24 Oct 2009 04:10:59 +0000 (+0900)
Subject: Make method generators extensible
X-Git-Tag: 0.40_01~40
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=f8cbb121afb89df0feb90dfa413eeaa4cebec85f

Make method generators extensible
---

diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm
index ad7a8f0..dc866c3 100755
--- a/lib/Mouse/Meta/Method/Accessor.pm
+++ b/lib/Mouse/Meta/Method/Accessor.pm
@@ -2,8 +2,13 @@ package Mouse::Meta::Method::Accessor;
 use Mouse::Util; # enables strict and warnings
 use Scalar::Util qw(blessed);
 
+sub _inline_slot{
+    my(undef, $self_var, $attr_name) = @_;
+    return sprintf '%s->{q{%s}}', $self_var, $attr_name;
+}
+
 sub _generate_accessor{
-    my (undef, $attribute, $class, $type) = @_;
+    my ($method_class, $attribute, $class, $type) = @_;
 
     my $name          = $attribute->name;
     my $default       = $attribute->default;
@@ -17,8 +22,7 @@ sub _generate_accessor{
     my $compiled_type_constraint = defined($constraint) ? $constraint->_compiled_type_constraint : undef;
 
     my $self  = '$_[0]';
-    my $key   = "q{$name}";
-    my $slot  = "$self\->{$key}";
+    my $slot  = $method_class->_inline_slot($self, $name);;
 
     $type ||= 'accessor';
 
diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm
index e931885..c2bcc51 100644
--- a/lib/Mouse/Meta/Method/Constructor.pm
+++ b/lib/Mouse/Meta/Method/Constructor.pm
@@ -1,6 +1,11 @@
 package Mouse::Meta::Method::Constructor;
 use Mouse::Util; # enables strict and warnings
 
+sub _inline_slot{
+    my(undef, $self_var, $attr_name) = @_;
+    return sprintf '%s->{q{%s}}', $self_var, $attr_name;
+}
+
 sub _generate_constructor {
     my ($class, $metaclass, $args) = @_;
 
@@ -42,7 +47,7 @@ sub _generate_constructor {
 }
 
 sub _generate_processattrs {
-    my ($class, $metaclass, $attrs) = @_;
+    my ($method_class, $metaclass, $attrs) = @_;
     my @res;
 
     my $has_triggers;
@@ -57,7 +62,7 @@ sub _generate_processattrs {
         my $type_constraint = $attr->type_constraint;
         my $need_coercion;
 
-        my $instance_slot  = "\$instance->{q{$key}}";
+        my $instance_slot  = $method_class->_inline_slot('$instance', $key);
         my $attr_var       = "\$attrs[$index]";
         my $constraint_var;