From: gfx Date: Tue, 15 Sep 2009 03:51:11 +0000 (+0900) Subject: Move MethodAccessor stuff to Attribute X-Git-Tag: 0.32~61 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=9c3c9a02cbb960d8b8d53708afd84800e4a42765 Move MethodAccessor stuff to Attribute --- diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index dfae8b2..43b796a 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -6,7 +6,6 @@ require overload; use Carp 'confess'; use Scalar::Util (); use Mouse::Meta::TypeConstraint; -use Mouse::Meta::Method::Accessor; sub new { my ($class, $name, %options) = @_; @@ -63,6 +62,111 @@ sub inlined_name { return $key; } +sub generate_accessor_method_inline { + my ($attribute) = @_; + + my $name = $attribute->name; + my $default = $attribute->default; + my $constraint = $attribute->type_constraint; + my $builder = $attribute->builder; + my $trigger = $attribute->trigger; + my $is_weak = $attribute->is_weak_ref; + my $should_deref = $attribute->should_auto_deref; + my $should_coerce = $attribute->should_coerce; + + my $compiled_type_constraint = $constraint ? $constraint->{_compiled_type_constraint} : undef; + + my $self = '$_[0]'; + my $key = $attribute->inlined_name; + + my $accessor = + '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . + "sub {\n"; + if ($attribute->_is_metadata eq 'rw') { + $accessor .= + '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . + 'if (scalar(@_) >= 2) {' . "\n"; + + my $value = '$_[1]'; + + if ($constraint) { + if ($should_coerce) { + $accessor .= + "\n". + '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . + 'my $val = Mouse::Util::TypeConstraints->typecast_constraints("'.$attribute->associated_class->name.'", $attribute->{type_constraint}, '.$value.');'; + $value = '$val'; + } + if ($compiled_type_constraint) { + $accessor .= + "\n". + '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . + 'unless ($compiled_type_constraint->('.$value.')) { + $attribute->verify_type_constraint_error($name, '.$value.', $attribute->{type_constraint}); + }' . "\n"; + } else { + $accessor .= + "\n". + '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . + 'unless ($constraint->check('.$value.')) { + $attribute->verify_type_constraint_error($name, '.$value.', $attribute->{type_constraint}); + }' . "\n"; + } + } + + # if there's nothing left to do for the attribute we can return during + # this setter + $accessor .= 'return ' if !$is_weak && !$trigger && !$should_deref; + + $accessor .= $self.'->{'.$key.'} = '.$value.';' . "\n"; + + if ($is_weak) { + $accessor .= 'Scalar::Util::weaken('.$self.'->{'.$key.'}) if ref('.$self.'->{'.$key.'});' . "\n"; + } + + if ($trigger) { + $accessor .= '$trigger->('.$self.', '.$value.');' . "\n"; + } + + $accessor .= "}\n"; + } + else { + $accessor .= 'Carp::confess("Cannot assign a value to a read-only accessor") if scalar(@_) >= 2;' . "\n"; + } + + if ($attribute->is_lazy) { + $accessor .= $self.'->{'.$key.'} = '; + + $accessor .= $attribute->has_builder + ? $self.'->$builder' + : ref($default) eq 'CODE' + ? '$default->('.$self.')' + : '$default'; + $accessor .= ' if !exists '.$self.'->{'.$key.'};' . "\n"; + } + + if ($should_deref) { + if (ref($constraint) && $constraint->name =~ '^ArrayRef\b') { + $accessor .= 'if (wantarray) { + return @{ '.$self.'->{'.$key.'} || [] }; + }'; + } + else { + $accessor .= 'if (wantarray) { + return %{ '.$self.'->{'.$key.'} || {} }; + }'; + } + } + + $accessor .= 'return '.$self.'->{'.$key.'}; + }'; + + my $sub = eval $accessor; + Carp::confess($@) if $@; + return $sub; +} + + sub generate_predicate { my $attribute = shift; my $key = $attribute->inlined_name; @@ -139,9 +243,7 @@ sub create { # install an accessor if ($attribute->_is_metadata eq 'rw' || $attribute->_is_metadata eq 'ro') { - my $code = Mouse::Meta::Method::Accessor->generate_accessor_method_inline( - $attribute, - ); + my $code = $attribute->generate_accessor_method_inline(); $class->add_method($name => $code); } diff --git a/lib/Mouse/Meta/Method/Accessor.pm b/lib/Mouse/Meta/Method/Accessor.pm deleted file mode 100644 index 38531bc..0000000 --- a/lib/Mouse/Meta/Method/Accessor.pm +++ /dev/null @@ -1,111 +0,0 @@ -package Mouse::Meta::Method::Accessor; -use strict; -use warnings; -use Carp (); - -# internal use only. do not call directly -sub generate_accessor_method_inline { - my ($class, $attribute) = @_; - - my $name = $attribute->name; - my $default = $attribute->default; - my $constraint = $attribute->type_constraint; - my $builder = $attribute->builder; - my $trigger = $attribute->trigger; - my $is_weak = $attribute->is_weak_ref; - my $should_deref = $attribute->should_auto_deref; - my $should_coerce = $attribute->should_coerce; - - my $compiled_type_constraint = $constraint ? $constraint->{_compiled_type_constraint} : undef; - - my $self = '$_[0]'; - my $key = $attribute->inlined_name; - - my $accessor = - '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . - "sub {\n"; - if ($attribute->_is_metadata eq 'rw') { - $accessor .= - '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . - 'if (scalar(@_) >= 2) {' . "\n"; - - my $value = '$_[1]'; - - if ($constraint) { - if ($should_coerce) { - $accessor .= - "\n". - '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . - 'my $val = Mouse::Util::TypeConstraints->typecast_constraints("'.$attribute->associated_class->name.'", $attribute->{type_constraint}, '.$value.');'; - $value = '$val'; - } - if ($compiled_type_constraint) { - $accessor .= - "\n". - '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . - 'unless ($compiled_type_constraint->('.$value.')) { - $attribute->verify_type_constraint_error($name, '.$value.', $attribute->{type_constraint}); - }' . "\n"; - } else { - $accessor .= - "\n". - '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . - 'unless ($constraint->check('.$value.')) { - $attribute->verify_type_constraint_error($name, '.$value.', $attribute->{type_constraint}); - }' . "\n"; - } - } - - # if there's nothing left to do for the attribute we can return during - # this setter - $accessor .= 'return ' if !$is_weak && !$trigger && !$should_deref; - - $accessor .= $self.'->{'.$key.'} = '.$value.';' . "\n"; - - if ($is_weak) { - $accessor .= 'Scalar::Util::weaken('.$self.'->{'.$key.'}) if ref('.$self.'->{'.$key.'});' . "\n"; - } - - if ($trigger) { - $accessor .= '$trigger->('.$self.', '.$value.');' . "\n"; - } - - $accessor .= "}\n"; - } - else { - $accessor .= 'Carp::confess("Cannot assign a value to a read-only accessor") if scalar(@_) >= 2;' . "\n"; - } - - if ($attribute->is_lazy) { - $accessor .= $self.'->{'.$key.'} = '; - - $accessor .= $attribute->has_builder - ? $self.'->$builder' - : ref($default) eq 'CODE' - ? '$default->('.$self.')' - : '$default'; - $accessor .= ' if !exists '.$self.'->{'.$key.'};' . "\n"; - } - - if ($should_deref) { - if (ref($constraint) && $constraint->name =~ '^ArrayRef\b') { - $accessor .= 'if (wantarray) { - return @{ '.$self.'->{'.$key.'} || [] }; - }'; - } - else { - $accessor .= 'if (wantarray) { - return %{ '.$self.'->{'.$key.'} || {} }; - }'; - } - } - - $accessor .= 'return '.$self.'->{'.$key.'}; - }'; - - my $sub = eval $accessor; - Carp::confess($@) if $@; - return $sub; -} - -1;