X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FTypeConstraint.pm;h=1a0b9a3a1200c63d59aa7945353fa1f4f1acfb79;hp=023cb37d948f1c9cffe72fd6616dda0a125df0df;hb=cc1318893656996b0892fa5809c1f12d4b765a9f;hpb=05a12aa45fbcd22111d4f5dde2736c8361540198 diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index 023cb37..1a0b9a3 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -2,10 +2,8 @@ package Mouse::Meta::TypeConstraint; use Mouse::Util qw(:meta); # enables strict and warnings use overload - 'bool' => sub { 1 }, # always true - + 'bool' => sub (){ 1 }, # always true '""' => sub { $_[0]->name }, # stringify to tc name - '|' => sub { # or-combination require Mouse::Util::TypeConstraints; return Mouse::Util::TypeConstraints::find_or_parse_type_constraint( @@ -35,8 +33,6 @@ sub new { Carp::confess("Constraint for $args{name} is not a CODE reference"); } - $args{package_defined_in} ||= caller; - my $self = bless \%args, $class; $self->compile_type_constraint() if !$self->{hand_optimized_type_constraint}; @@ -46,7 +42,6 @@ sub new { sub create_child_type{ my $self = shift; - # XXX: FIXME return ref($self)->new( # a child inherits its parent's attributes %{$self}, @@ -67,6 +62,10 @@ sub name; sub parent; sub message; sub has_coercion; + +sub type_parameter; +sub __is_parameterized; + sub _compiled_type_constraint; sub _compiled_type_coercion; @@ -75,7 +74,7 @@ sub compile_type_constraint; sub _add_type_coercions{ my $self = shift; - my $coercions = ($self->{_coercion_map} ||= []); + my $coercions = ($self->{coercion_map} ||= []); my %has = map{ $_->[0] => undef } @{$coercions}; for(my $i = 0; $i < @_; $i++){ @@ -105,7 +104,7 @@ sub _add_type_coercions{ sub _compile_type_coercion { my($self) = @_; - my @coercions = @{$self->{_coercion_map}}; + my @coercions = @{$self->{coercion_map}}; $self->{_compiled_type_coercion} = sub { my($thing) = @_; @@ -211,15 +210,22 @@ sub parameterize{ || Carp::confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type"); return Mouse::Meta::TypeConstraint->new( - name => $name, - parent => $self, - parameter => $param, - constraint => $generator->($param), # must be 'constraint', not 'optimized' - - type => 'Parameterized', + name => $name, + parent => $self, + type_parameter => $param, + constraint => $generator->($param), # must be 'constraint', not 'optimized' ); } +sub assert_valid { + my ($self, $value) = @_; + + if(!$self->_compiled_type_constraint->($value)){ + Carp::confess($self->get_message($value)); + } + return 1; +} + 1; __END__ @@ -229,7 +235,7 @@ Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass =head1 VERSION -This document describes Mouse version 0.50_01 +This document describes Mouse version 0.50_03 =head1 DESCRIPTION