X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FTypeConstraint.pm;h=c01e21bb71587ea84fc79b0f3e4a3181f2d679e5;hb=7537134acef99fb05d05136200032945259d7073;hp=dc34532bf3e8af47dc4bfe5d67bc452e3239e476;hpb=785080642e584152fc8d7e87d77f11c7483d3f14;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index dc34532..c01e21b 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -1,11 +1,11 @@ package Mouse::Meta::TypeConstraint; use Mouse::Util qw(:meta); # enables strict and warnings +use Scalar::Util (); use overload - 'bool' => sub { 1 }, # always true - + 'bool' => sub (){ 1 }, # always true '""' => sub { $_[0]->name }, # stringify to tc name - + '0+' => sub { Scalar::Util::refaddr($_[0]) }, '|' => sub { # or-combination require Mouse::Util::TypeConstraints; return Mouse::Util::TypeConstraints::find_or_parse_type_constraint( @@ -15,10 +15,9 @@ use overload fallback => 1; -use Carp (); - sub new { - my($class, %args) = @_; + my $class = shift; + my %args = @_ == 1 ? %{$_[0]} : @_; $args{name} = '__ANON__' if !defined $args{name}; @@ -32,11 +31,9 @@ sub new { $check = $args{constraint}; if(defined($check) && ref($check) ne 'CODE'){ - Carp::confess("Constraint for $args{name} is not a CODE reference"); + $class->throw_error("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 +43,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,15 +63,22 @@ sub name; sub parent; sub message; sub has_coercion; + +sub check; + +sub type_parameter; +sub __is_parameterized; + sub _compiled_type_constraint; sub _compiled_type_coercion; 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++){ @@ -83,18 +86,18 @@ sub _add_type_coercions{ my $action = $_[++$i]; if(exists $has{$from}){ - Carp::confess("A coercion action already exists for '$from'"); + $self->throw_error("A coercion action already exists for '$from'"); } my $type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint($from) - or Carp::confess("Could not find the type constraint ($from) to coerce from"); + or $self->throw_error("Could not find the type constraint ($from) to coerce from"); push @{$coercions}, [ $type => $action ]; } # compile if(exists $self->{type_constraints}){ # union type - Carp::confess("Cannot add additional type coercions to Union types"); + $self->throw_error("Cannot add additional type coercions to Union types"); } else{ $self->_compile_type_coercion(); @@ -105,7 +108,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) = @_; @@ -143,20 +146,15 @@ sub _compile_union_type_coercion { return; } -sub check { - my $self = shift; - return $self->_compiled_type_constraint->(@_); -} - sub coerce { my $self = shift; my $coercion = $self->_compiled_type_coercion; if(!$coercion){ - Carp::confess("Cannot coerce without a type coercion"); + $self->throw_error("Cannot coerce without a type coercion"); } - return $_[0] if $self->_compiled_type_constraint->(@_); + return $_[0] if $self->check(@_); return $coercion->(@_); } @@ -169,7 +167,7 @@ sub get_message { } else { $value = ( defined $value ? overload::StrVal($value) : 'undef' ); - return "Validation failed for '$self' failed with value $value"; + return "Validation failed for '$self' with value $value"; } } @@ -208,27 +206,30 @@ sub parameterize{ $name ||= sprintf '%s[%s]', $self->name, $param->name; my $generator = $self->{constraint_generator} - || Carp::confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type"); + || $self->throw_error("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type"); return Mouse::Meta::TypeConstraint->new( name => $name, parent => $self, type_parameter => $param, constraint => $generator->($param), # must be 'constraint', not 'optimized' - - type => 'Parameterized', ); } sub assert_valid { my ($self, $value) = @_; - if(!$self->_compiled_type_constraint->($value)){ - Carp::confess($self->get_message($value)); + if(!$self->check($value)){ + $self->throw_error($self->get_message($value)); } return 1; } +sub throw_error { + require Mouse::Meta::Module; + goto &Mouse::Meta::Module::throw_error; +} + 1; __END__ @@ -238,7 +239,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.64 =head1 DESCRIPTION