X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FAccessor.pm;h=4e0f2a02feaeefbad1a4d1c97fe9203bb2b89e87;hb=6a7756cc831fa21bc28b924a8edbaeeb28a4a66b;hp=667f2ea7632f4b12554f092ab0c4eac31f642144;hpb=3db78d2a0679fe91cf54ec25013d41db02a440d7;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm old mode 100755 new mode 100644 index 667f2ea..4e0f2a0 --- a/lib/Mouse/Meta/Method/Accessor.pm +++ b/lib/Mouse/Meta/Method/Accessor.pm @@ -1,15 +1,17 @@ package Mouse::Meta::Method::Accessor; use Mouse::Util qw(:meta); # enables strict and warnings -use warnings FATAL => 'recursion'; -use Mouse::Meta::Method::Constructor; # for slot access +use constant _MOUSE_DEBUG => !!$ENV{MOUSE_DEBUG}; + +sub _inline_slot{ + my(undef, $self_var, $attr_name) = @_; + return sprintf '%s->{q{%s}}', $self_var, $attr_name; +} sub _generate_accessor_any{ my($method_class, $type, $attribute, $class) = @_; - my $c = 'Mouse::Meta::Method::Constructor'; - - my $key = $attribute->name; + my $name = $attribute->name; my $default = $attribute->default; my $constraint = $attribute->type_constraint; my $builder = $attribute->builder; @@ -20,14 +22,11 @@ sub _generate_accessor_any{ my $compiled_type_constraint = defined($constraint) ? $constraint->_compiled_type_constraint : undef; - my $instance = '$_[0]'; - my $slot = $c->_inline_get_slot($instance, $key);; + my $self = '$_[0]'; + my $slot = $method_class->_inline_slot($self, $name);; - 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 + my $accessor = sprintf(qq{package %s;\n#line 1 "%s-accessor for %s (%s)"\n}, $class->name, $type, $name, __FILE__) + . "sub {\n"; if ($type eq 'rw' || $type eq 'wo') { if($type eq 'rw'){ @@ -36,7 +35,7 @@ END_SUB_START } else{ # writer $accessor .= - 'if(@_ < 2){ Carp::confess("Not enough arguments for the writer of '.$key.'") }'. + 'if(@_ < 2){ Carp::confess("Not enough arguments for the writer of $name") }'. '{' . "\n"; } @@ -59,54 +58,54 @@ END_SUB_START # this setter $accessor .= 'return ' if !$is_weak && !$trigger && !$should_deref; - $accessor .= $c->_inline_set_slot($instance, $key, $value) . ";\n"; + $accessor .= "$slot = $value;\n"; if ($is_weak) { - $accessor .= $c->_inline_weaken_slot($instance, $key) ." if ref $slot;\n"; + $accessor .= "Scalar::Util::weaken($slot) if ref $slot;\n"; } if ($trigger) { - $accessor .= '$trigger->('.$instance.', '.$value.');' . "\n"; + $accessor .= '$trigger->('.$self.', '.$value.');' . "\n"; } $accessor .= "}\n"; } elsif($type eq 'ro') { - $accessor .= 'Carp::confess("Cannot assign a value to a read-only accessor") if scalar(@_) >= 2;' . "\n"; + $accessor .= 'Carp::confess("Cannot assign a value to a read-only accessor of $name") if scalar(@_) >= 2;' . "\n"; } else{ $class->throw_error("Unknown accessor type '$type'"); } - if ($attribute->is_lazy) { + if ($attribute->is_lazy and $type ne 'wo') { my $value; if (defined $builder){ - $value = "$instance->\$builder()"; + $value = "$self->\$builder()"; } elsif (ref($default) eq 'CODE'){ - $value = "$instance->\$default()"; + $value = "$self->\$default()"; } else{ $value = '$default'; } - $accessor .= sprintf "if(!%s){\n", $c->_inline_has_slot($instance, $key); + $accessor .= "els" if $type eq 'rw'; + $accessor .= "if(!exists $slot){\n"; if($should_coerce){ - $value = "\$constraint->coerce($value)"; + $accessor .= "$slot = \$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"; - $value = '$tmp'; + $accessor .= "$slot = \$tmp;\n"; + } + else{ + $accessor .= "$slot = $value;\n"; } - - $accessor .= $c->_inline_set_slot($instance, $key, $value) .";\n"; - if ($is_weak) { - $accessor .= $c->_inline_weaken_slot($instance, $key) . " if ref $slot;\n"; + $accessor .= "Scalar::Util::weaken($slot) if ref $slot;\n"; } $accessor .= "}\n"; } @@ -125,7 +124,7 @@ END_SUB_START $accessor .= "return $slot;\n}\n"; - #print $accessor, "\n"; + warn $accessor if _MOUSE_DEBUG; my $code; my $e = do{ local $@; @@ -138,22 +137,26 @@ END_SUB_START } sub _generate_accessor{ - my $class = shift; - return $class->_generate_accessor_any(rw => @_); + #my($self, $attribute, $metaclass) = @_; + my $self = shift; + return $self->_generate_accessor_any(rw => @_); } sub _generate_reader { - my $class = shift; - return $class->_generate_accessor_any(ro => @_); + #my($self, $attribute, $metaclass) = @_; + my $self = shift; + return $self->_generate_accessor_any(ro => @_); } sub _generate_writer { - my $class = shift; - return $class->_generate_accessor_any(wo => @_); + #my($self, $attribute, $metaclass) = @_; + my $self = shift; + return $self->_generate_accessor_any(wo => @_); } sub _generate_predicate { - my (undef, $attribute, $class) = @_; + #my($self, $attribute, $metaclass) = @_; + my(undef, $attribute) = @_; my $slot = $attribute->name; return sub{ @@ -162,7 +165,8 @@ sub _generate_predicate { } sub _generate_clearer { - my (undef, $attribute, $class) = @_; + #my($self, $attribute, $metaclass) = @_; + my(undef, $attribute) = @_; my $slot = $attribute->name; return sub{ @@ -179,7 +183,7 @@ Mouse::Meta::Method::Accessor - A Mouse method generator for accessors =head1 VERSION -This document describes Mouse version 0.50_04 +This document describes Mouse version 0.78 =head1 SEE ALSO