X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=65d6daf77999218c1ee62f1ae9446fce6579488c;hb=11d415286701d3b51e517cb6826138808967cb89;hp=43b796a72967ad524c53f2c4a53c6e88bbdf98f4;hpb=b5767a3a9505e854df8677a571a4d29dcc425c71;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 43b796a..65d6daf 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -1,7 +1,6 @@ package Mouse::Meta::Attribute; use strict; use warnings; -require overload; use Carp 'confess'; use Scalar::Util (); @@ -55,14 +54,12 @@ sub _create_args { $_[0]->{_create_args} } -sub inlined_name { +sub _inlined_name { my $self = shift; - my $name = $self->name; - my $key = "'" . $name . "'"; - return $key; + return sprintf '"%s"', quotemeta $self->name; } -sub generate_accessor_method_inline { +sub _generate_accessor{ my ($attribute) = @_; my $name = $attribute->name; @@ -77,7 +74,7 @@ sub generate_accessor_method_inline { my $compiled_type_constraint = $constraint ? $constraint->{_compiled_type_constraint} : undef; my $self = '$_[0]'; - my $key = $attribute->inlined_name; + my $key = $attribute->_inlined_name; my $accessor = '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . @@ -167,9 +164,9 @@ sub generate_accessor_method_inline { } -sub generate_predicate { +sub _generate_predicate { my $attribute = shift; - my $key = $attribute->inlined_name; + my $key = $attribute->_inlined_name; my $predicate = 'sub { exists($_[0]->{'.$key.'}) }'; @@ -178,9 +175,9 @@ sub generate_predicate { return $sub; } -sub generate_clearer { +sub _generate_clearer { my $attribute = shift; - my $key = $attribute->inlined_name; + my $key = $attribute->_inlined_name; my $clearer = 'sub { delete($_[0]->{'.$key.'}) }'; @@ -189,7 +186,7 @@ sub generate_clearer { return $sub; } -sub generate_handles { +sub _generate_handles { my $attribute = shift; my $reader = $attribute->name; my %handles = $attribute->_canonicalize_handles($attribute->handles); @@ -241,28 +238,39 @@ sub create { $class->add_attribute($attribute); + my $associated_methods = 0; + + my $is_metadata = $attribute->_is_metadata || ''; + # install an accessor - if ($attribute->_is_metadata eq 'rw' || $attribute->_is_metadata eq 'ro') { - my $code = $attribute->generate_accessor_method_inline(); + if ($is_metadata eq 'rw' || $is_metadata eq 'ro') { + my $code = $attribute->_generate_accessor(); $class->add_method($name => $code); + $associated_methods++; } for my $method (qw/predicate clearer/) { my $predicate = "has_$method"; if ($attribute->$predicate) { - my $generator = "generate_$method"; + my $generator = "_generate_$method"; my $coderef = $attribute->$generator; $class->add_method($attribute->$method => $coderef); + $associated_methods++; } } if ($attribute->has_handles) { - my $method_map = $attribute->generate_handles; + my $method_map = $attribute->_generate_handles; for my $method_name (keys %$method_map) { $class->add_method($method_name => $method_map->{$method_name}); + $associated_methods++; } } + if($associated_methods == 0 && $is_metadata ne 'bare'){ + confess(qq{Attribute ($name) of class }.$class->name.qq{ has no associated methods (did you mean to provide an "is" argument?)}); + } + return $attribute; } @@ -450,22 +458,6 @@ installed. Some error checking is done. Informational methods. -=head2 generate_accessor -> CODE - -Creates a new code reference for the attribute's accessor. - -=head2 generate_predicate -> CODE - -Creates a new code reference for the attribute's predicate. - -=head2 generate_clearer -> CODE - -Creates a new code reference for the attribute's clearer. - -=head2 generate_handles -> { MethodName => CODE } - -Creates a new code reference for each of the attribute's handles methods. - =head2 verify_against_type_constraint Item -> 1 | ERROR Checks that the given value passes this attribute's type constraint. Returns 1