X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FAccessor.pm;h=b3545bd3d74136d8b430655c135b7c4bd9d21df7;hb=26f0aa174f72fdf5fd803278212b7cefa83c8734;hp=2a1a38a0d737289741e9b95aa32161138d329006;hpb=c2168931940aa681120ba25c60658fe33c42cc1d;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 2a1a38a..b3545bd --- a/lib/Mouse/Meta/Method/Accessor.pm +++ b/lib/Mouse/Meta/Method/Accessor.pm @@ -1,7 +1,7 @@ package Mouse::Meta::Method::Accessor; use Mouse::Util qw(:meta); # enables strict and warnings -use warnings FATAL => 'recursion'; +use constant _MOUSE_DEBUG => !!$ENV{MOUSE_DEBUG}; sub _inline_slot{ my(undef, $self_var, $attr_name) = @_; @@ -35,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"; } @@ -71,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){ @@ -90,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"; @@ -124,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 $@; @@ -137,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{ @@ -161,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{ @@ -178,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.77 =head1 SEE ALSO