X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod%2FAccessor.pm;h=621a259b9c7ee61f7c483faefa3122ce2270e19b;hb=2a464664052830d5fad036569d5ccb3964c7f592;hp=eb9152dcf2f5ba086d33a6d7a87c393793d06f22;hpb=cfa6d970245f1bbc9330c0e4bb3342356a43ac16;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm index eb9152d..621a259 100755 --- a/lib/Mouse/Meta/Method/Accessor.pm +++ b/lib/Mouse/Meta/Method/Accessor.pm @@ -3,7 +3,7 @@ use strict; use warnings; use Scalar::Util qw(blessed); -sub _install_accessor{ +sub _generate_accessor{ my (undef, $attribute, $method_name, $class, $type) = @_; my $name = $attribute->name; @@ -24,7 +24,8 @@ sub _install_accessor{ my $accessor = '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . - "sub {\n"; + sprintf("sub %s {\n", defined($method_name) ? $class->name . '::' . $method_name : ''); + if ($type eq 'accessor' || $type eq 'writer') { if($type eq 'accessor'){ $accessor .= @@ -34,7 +35,7 @@ sub _install_accessor{ else{ # writer $accessor .= '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . - 'if(@_ < 2){ Carp::confess("Not enough arguments for writer '.$method_name.'") }'. + 'if(@_ < 2){ Carp::confess("Not enough arguments for the writer of '.$name.'") }'. '{' . "\n"; } @@ -117,27 +118,29 @@ sub _install_accessor{ $accessor .= 'return '.$self.'->{'.$key."};\n}"; #print $accessor, "\n"; - my $code = eval $accessor; - $attribute->throw_error($@) if $@; - - $class->add_method($method_name => $code); - return; + my $code; + my $e = do{ + local $@; + $code = eval $accessor; + $@; + }; + die $e if $e; + + return $code; # returns a CODE ref unless $method_name is passed } -sub _install_reader{ +sub _generate_reader{ my $class = shift; - $class->_install_accessor(@_, 'reader'); - return; + return $class->_generate_accessor(@_, 'reader'); } -sub _install_writer{ +sub _generate_writer{ my $class = shift; - $class->_install_accessor(@_, 'writer'); - return; + return $class->_generate_accessor(@_, 'writer'); } -sub _install_predicate { +sub _generate_predicate { my (undef, $attribute, $method_name, $class) = @_; my $slot = $attribute->name; @@ -148,7 +151,7 @@ sub _install_predicate { return; } -sub _install_clearer { +sub _generate_clearer { my (undef, $attribute, $method_name, $class) = @_; my $slot = $attribute->name; @@ -159,7 +162,7 @@ sub _install_clearer { return; } -sub _install_handles { +sub _generate_handles { my (undef, $attribute, $handles, $class) = @_; my $reader = $attribute->reader || $attribute->accessor