X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FAccessor.pm;h=6e4d4021aec7024c9841d64ddede187a29ee1526;hb=refs%2Ftags%2F0.82;hp=b34cd5feb32b6f6272530e5a937be14659b0a0cc;hpb=da23cd4afe3c5b0add3a9ed24a43696deb380f2b;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 b34cd5f..6e4d402 --- a/lib/Mouse/Meta/Method/Accessor.pm +++ b/lib/Mouse/Meta/Method/Accessor.pm @@ -1,6 +1,8 @@ package Mouse::Meta::Method::Accessor; use Mouse::Util qw(:meta); # enables strict and warnings +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; @@ -33,7 +35,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 $name") }'. '{' . "\n"; } @@ -69,13 +71,13 @@ sub _generate_accessor_any{ $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){ @@ -88,13 +90,13 @@ sub _generate_accessor_any{ $value = '$default'; } + $accessor .= "els" if $type eq 'rw'; $accessor .= "if(!exists $slot){\n"; if($should_coerce){ $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"; $accessor .= "$slot = \$tmp;\n"; @@ -122,7 +124,7 @@ sub _generate_accessor_any{ $accessor .= "return $slot;\n}\n"; - #print $accessor, "\n"; + warn $accessor if _MOUSE_DEBUG; my $code; my $e = do{ local $@; @@ -135,22 +137,26 @@ sub _generate_accessor_any{ } 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{ @@ -159,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{ @@ -176,7 +183,7 @@ Mouse::Meta::Method::Accessor - A Mouse method generator for accessors =head1 VERSION -This document describes Mouse version 0.44 +This document describes Mouse version 0.82 =head1 SEE ALSO