From: gfx Date: Sat, 27 Feb 2010 07:17:56 +0000 (+0900) Subject: Refactor pp method generators X-Git-Tag: 0.50_05~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=3db78d2a0679fe91cf54ec25013d41db02a440d7 Refactor pp method generators --- diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm index 2a1a38a..667f2ea 100755 --- a/lib/Mouse/Meta/Method/Accessor.pm +++ b/lib/Mouse/Meta/Method/Accessor.pm @@ -2,16 +2,14 @@ package Mouse::Meta::Method::Accessor; use Mouse::Util qw(:meta); # enables strict and warnings use warnings FATAL => 'recursion'; - -sub _inline_slot{ - my(undef, $self_var, $attr_name) = @_; - return sprintf '%s->{q{%s}}', $self_var, $attr_name; -} +use Mouse::Meta::Method::Constructor; # for slot access sub _generate_accessor_any{ my($method_class, $type, $attribute, $class) = @_; - my $name = $attribute->name; + my $c = 'Mouse::Meta::Method::Constructor'; + + my $key = $attribute->name; my $default = $attribute->default; my $constraint = $attribute->type_constraint; my $builder = $attribute->builder; @@ -22,11 +20,14 @@ sub _generate_accessor_any{ my $compiled_type_constraint = defined($constraint) ? $constraint->_compiled_type_constraint : undef; - my $self = '$_[0]'; - my $slot = $method_class->_inline_slot($self, $name);; + my $instance = '$_[0]'; + my $slot = $c->_inline_get_slot($instance, $key);; - my $accessor = sprintf(qq{package %s;\n#line 1 "%s-accessor for %s (%s)"\n}, $class->name, $type, $name, __FILE__) - . "sub {\n"; + my $accessor = sprintf(<<'END_SUB_START', $class->name, __LINE__, $type, $key, __FILE__); +package %s; +#line %d "%s-accessor for %s (%s) +sub { +END_SUB_START if ($type eq 'rw' || $type eq 'wo') { if($type eq 'rw'){ @@ -35,7 +36,7 @@ sub _generate_accessor_any{ } else{ # writer $accessor .= - 'if(@_ < 2){ Carp::confess("Not enough arguments for the writer of '.$name.'") }'. + 'if(@_ < 2){ Carp::confess("Not enough arguments for the writer of '.$key.'") }'. '{' . "\n"; } @@ -58,14 +59,14 @@ sub _generate_accessor_any{ # this setter $accessor .= 'return ' if !$is_weak && !$trigger && !$should_deref; - $accessor .= "$slot = $value;\n"; + $accessor .= $c->_inline_set_slot($instance, $key, $value) . ";\n"; if ($is_weak) { - $accessor .= "Scalar::Util::weaken($slot) if ref $slot;\n"; + $accessor .= $c->_inline_weaken_slot($instance, $key) ." if ref $slot;\n"; } if ($trigger) { - $accessor .= '$trigger->('.$self.', '.$value.');' . "\n"; + $accessor .= '$trigger->('.$instance.', '.$value.');' . "\n"; } $accessor .= "}\n"; @@ -81,31 +82,31 @@ sub _generate_accessor_any{ my $value; if (defined $builder){ - $value = "$self->\$builder()"; + $value = "$instance->\$builder()"; } elsif (ref($default) eq 'CODE'){ - $value = "$self->\$default()"; + $value = "$instance->\$default()"; } else{ $value = '$default'; } - $accessor .= "if(!exists $slot){\n"; + $accessor .= sprintf "if(!%s){\n", $c->_inline_has_slot($instance, $key); if($should_coerce){ - $accessor .= "$slot = \$constraint->coerce($value)"; + $value = "\$constraint->coerce($value)"; } elsif(defined $constraint){ $accessor .= "my \$tmp = $value;\n"; $accessor .= "\$compiled_type_constraint->(\$tmp)"; $accessor .= " || \$attribute->_throw_type_constraint_error(\$tmp, \$constraint);\n"; - $accessor .= "$slot = \$tmp;\n"; - } - else{ - $accessor .= "$slot = $value;\n"; + $value = '$tmp'; } + + $accessor .= $c->_inline_set_slot($instance, $key, $value) .";\n"; + if ($is_weak) { - $accessor .= "Scalar::Util::weaken($slot) if ref $slot;\n"; + $accessor .= $c->_inline_weaken_slot($instance, $key) . " if ref $slot;\n"; } $accessor .= "}\n"; } diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index efd31bf..22acc34 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -1,40 +1,71 @@ package Mouse::Meta::Method::Constructor; use Mouse::Util qw(:meta); # enables strict and warnings -sub _inline_slot{ +sub _inline_create_instance { + my(undef, $class_expr) = @_; + return "bless {}, $class_expr"; +} + +sub _inline_slot { my(undef, $self_var, $attr_name) = @_; return sprintf '%s->{q{%s}}', $self_var, $attr_name; } +sub _inline_has_slot { + my($class, $self_var, $attr_name) = @_; + + return sprintf 'exists(%s)', $class->_inline_slot($self_var, $attr_name); +} + +sub _inline_get_slot { + my($class, $self_var, $attr_name) = @_; + + return $class->_inline_slot($self_var, $attr_name); +} + +sub _inline_set_slot { + my($class, $self_var, $attr_name, $rvalue) = @_; + + return $class->_inline_slot($self_var, $attr_name) . " = $rvalue"; +} + +sub _inline_weaken_slot { + my($class, $self_var, $attr_name) = @_; + + return sprintf 'Scalar::Util::weaken(%s)', $class->_inline_slot($self_var, $attr_name); +} + sub _generate_constructor { my ($class, $metaclass, $args) = @_; - my $associated_metaclass_name = $metaclass->name; - my @attrs = $metaclass->get_all_attributes; - my $buildall = $class->_generate_BUILDALL($metaclass); + my $init_attrs = $class->_generate_processattrs($metaclass, \@attrs); my $buildargs = $class->_generate_BUILDARGS($metaclass); - my $processattrs = $class->_generate_processattrs($metaclass, \@attrs); + my $buildall = $class->_generate_BUILDALL($metaclass); my @checks = map { $_ && $_->_compiled_type_constraint } map { $_->type_constraint } @attrs; - my $source = sprintf("#line %d %s\n", __LINE__, __FILE__).<<"..."; - sub \{ - my \$class = shift; - return \$class->Mouse::Object::new(\@_) - if \$class ne q{$associated_metaclass_name}; + my $class_name = $metaclass->name; + my $source = sprintf(<<'END_CONSTRUCTOR', $class_name, __LINE__, __FILE__, $class_name, $buildargs, $class->_inline_create_instance('$class'), $init_attrs, $buildall); +package %s; +#line %d "constructor of %s (%s)" + sub { + my $class = shift; + return $class->Mouse::Object::new(@_) + if $class ne __PACKAGE__; # BUILDARGS - $buildargs; - my \$instance = bless {}, \$class; + %s; + # create instance + my $instance = %s; # process attributes - $processattrs; + %s; # BUILDALL - $buildall; - return \$instance; + %s; + return $instance; } -... +END_CONSTRUCTOR #warn $source; my $code; my $e = do{ @@ -68,7 +99,8 @@ sub _generate_processattrs { my $is_weak_ref = $attr->is_weak_ref; my $need_coercion; - my $instance_slot = $method_class->_inline_slot('$instance', $key); + my $instance = '$instance'; + my $instance_slot = $method_class->_inline_get_slot($instance, $key); my $attr_var = "\$attrs[$index]"; my $constraint_var; @@ -85,7 +117,7 @@ sub _generate_processattrs { $post_process .= " or $attr_var->_throw_type_constraint_error($instance_slot, $constraint_var);\n"; } if($is_weak_ref){ - $post_process .= "Scalar::Util::weaken($instance_slot) if ref $instance_slot;\n"; + $post_process .= $method_class->_inline_weaken_slot($instance, $key) . " if ref $instance_slot;\n"; } if (defined $init_arg) { @@ -97,7 +129,7 @@ sub _generate_processattrs { $value = "$constraint_var->coerce($value)"; } - $code .= "$instance_slot = $value;\n"; + $code .= $method_class->_inline_set_slot($instance, $key, $value) . ";\n"; $code .= $post_process; if ($attr->has_trigger) { @@ -135,9 +167,9 @@ sub _generate_processattrs { $value = "$constraint_var->coerce($value)"; } - $code .= "$instance_slot = $value;\n"; + $code .= $method_class->_inline_set_slot($instance, $key, $value) . ";\n"; if($is_weak_ref){ - $code .= "Scalar::Util::weaken($instance_slot);\n"; + $code .= $method_class->_inline_weaken_slot($instance, $key) . ";\n"; } } }