X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=dec1300d931b1c739fd73de911ed1fc9bf729bcd;hb=815f725aeff0bd44da8d75e7cd4ac456e9e60238;hp=9f680706e4d89110e07d9445fde4e7d851f8802c;hpb=b3b74cc602b1f2490396e407aa38970b5aa6921a;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 9f68070..dec1300 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -1,53 +1,50 @@ -#!/usr/bin/env perl package Mouse::Meta::Attribute; use strict; use warnings; require overload; use Carp 'confess'; -require Mouse::Util; +use Scalar::Util (); sub new { - my $class = shift; - my %args = @_; + my ($class, $name, %options) = @_; - my $name = $args{name}; + $options{name} = $name; - $args{init_arg} = $name - unless exists $args{init_arg}; + $options{init_arg} = $name + unless exists $options{init_arg}; - $args{is} ||= ''; + $options{is} ||= ''; - bless \%args, $class; + bless \%options, $class; } -sub name { $_[0]->{name} } -sub associated_class { $_[0]->{associated_class} } -sub _is_metadata { $_[0]->{is} } -sub is_required { $_[0]->{required} } -sub default { $_[0]->{default} } -sub is_lazy { $_[0]->{lazy} } -sub is_lazy_build { $_[0]->{lazy_build} } -sub predicate { $_[0]->{predicate} } -sub clearer { $_[0]->{clearer} } -sub handles { $_[0]->{handles} } -sub is_weak_ref { $_[0]->{weak_ref} } -sub init_arg { $_[0]->{init_arg} } -sub type_constraint { $_[0]->{type_constraint} } -sub trigger { $_[0]->{trigger} } -sub builder { $_[0]->{builder} } -sub should_auto_deref { $_[0]->{auto_deref} } -sub should_coerce { $_[0]->{should_coerce} } - -sub has_default { exists $_[0]->{default} } -sub has_predicate { exists $_[0]->{predicate} } -sub has_clearer { exists $_[0]->{clearer} } -sub has_handles { exists $_[0]->{handles} } -sub has_type_constraint { exists $_[0]->{type_constraint} } -sub has_trigger { exists $_[0]->{trigger} } -sub has_builder { exists $_[0]->{builder} } - -sub find_type_constraint { $_[0]->{find_type_constraint} } +sub name { $_[0]->{name} } +sub associated_class { $_[0]->{associated_class} } +sub _is_metadata { $_[0]->{is} } +sub is_required { $_[0]->{required} } +sub default { $_[0]->{default} } +sub is_lazy { $_[0]->{lazy} } +sub is_lazy_build { $_[0]->{lazy_build} } +sub predicate { $_[0]->{predicate} } +sub clearer { $_[0]->{clearer} } +sub handles { $_[0]->{handles} } +sub is_weak_ref { $_[0]->{weak_ref} } +sub init_arg { $_[0]->{init_arg} } +sub type_constraint { $_[0]->{type_constraint} } +sub trigger { $_[0]->{trigger} } +sub builder { $_[0]->{builder} } +sub should_auto_deref { $_[0]->{auto_deref} } +sub should_coerce { $_[0]->{should_coerce} } +sub find_type_constraint { $_[0]->{find_type_constraint} } + +sub has_default { exists $_[0]->{default} } +sub has_predicate { exists $_[0]->{predicate} } +sub has_clearer { exists $_[0]->{clearer} } +sub has_handles { exists $_[0]->{handles} } +sub has_type_constraint { exists $_[0]->{type_constraint} } +sub has_trigger { exists $_[0]->{trigger} } +sub has_builder { exists $_[0]->{builder} } sub _create_args { $_[0]->{_create_args} = $_[1] if @_ > 1; @@ -78,14 +75,14 @@ sub generate_accessor { my $accessor = "sub {\n"; if ($attribute->_is_metadata eq 'rw') { - $accessor .= 'if (scalar(@_) >= 2) {' . "\n"; + $accessor .= 'if (exists $_[1]) {' . "\n"; my $value = '$_[1]'; if ($constraint) { $accessor .= 'my $val = '; if ($should_coerce) { - $accessor .= 'Mouse::TypeRegistry->typecast_constraints("'.$attribute->associated_class->name.'", $attribute->{find_type_constraint}, $attribute->{type_constraint}, '.$value.');'; + $accessor .= 'Mouse::Util::TypeConstraints->typecast_constraints("'.$attribute->associated_class->name.'", $attribute->{find_type_constraint}, $attribute->{type_constraint}, '.$value.');'; } else { $accessor .= $value.';'; } @@ -104,7 +101,7 @@ sub generate_accessor { $accessor .= $self.'->{'.$key.'} = '.$value.';' . "\n"; if ($is_weak) { - $accessor .= 'Mouse::Util::weaken('.$self.'->{'.$key.'}) if ref('.$self.'->{'.$key.'});' . "\n"; + $accessor .= 'Scalar::Util::weaken('.$self.'->{'.$key.'}) if ref('.$self.'->{'.$key.'});' . "\n"; } if ($trigger) { @@ -184,7 +181,7 @@ sub generate_handles { my $method = 'sub { my $self = shift; - $self->$reader->$remote_method(@_) + $self->'.$reader.'->'.$remote_method.'(@_) }'; $method_map{$local_method} = eval $method; @@ -212,16 +209,16 @@ sub create { my @type_constraints = split /\|/, $type_constraint; my $code; - my $optimized_constraints = Mouse::TypeRegistry->optimized_constraints; + my $optimized_constraints = Mouse::Util::TypeConstraints->optimized_constraints; if (@type_constraints == 1) { $code = $optimized_constraints->{$type_constraints[0]} || - sub { Mouse::Util::blessed($_) && Mouse::Util::blessed($_) eq $type_constraints[0] }; + sub { Scalar::Util::blessed($_) && $_->isa($type_constraints[0]) }; $args{type_constraint} = $type_constraints[0]; } else { my @code_list = map { my $type = $_; $optimized_constraints->{$type} || - sub { Mouse::Util::blessed($_) && Mouse::Util::blessed($_) eq $type } + sub { Scalar::Util::blessed($_) && $_->isa($type) } } @type_constraints; $code = sub { for my $code (@code_list) { @@ -234,7 +231,7 @@ sub create { $args{find_type_constraint} = $code; } - my $attribute = $self->new(%args); + my $attribute = $self->new($name, %args); $attribute->_create_args(\%args); @@ -325,7 +322,7 @@ sub validate_args { return 1; } -sub verify_type_constraint { +sub verify_against_type_constraint { return 1 unless $_[0]->{type_constraint}; local $_ = $_[1]; @@ -345,7 +342,7 @@ sub verify_type_constraint_error { sub coerce_constraint { ## my($self, $value) = @_; my $type = $_[0]->{type_constraint} or return $_[1]; - return Mouse::TypeRegistry->typecast_constraints($_[0]->associated_class->name, $_[0]->find_type_constraint, $type, $_[1]); + return Mouse::Util::TypeConstraints->typecast_constraints($_[0]->associated_class->name, $_[0]->find_type_constraint, $type, $_[1]); } sub _canonicalize_handles { @@ -472,7 +469,7 @@ Creates a new code reference for each of the attribute's handles methods. Returns a code reference which can be used to check that a given value passes this attribute's type constraint; -=head2 verify_type_constraint Item -> 1 | ERROR +=head2 verify_against_type_constraint Item -> 1 | ERROR Checks that the given value passes this attribute's type constraint. Returns 1 on success, otherwise Ces.