X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=17826b10db323e482b1a4de487283b8a35072a77;hb=4353bfe169e0ca10723b6da1085b7ce0220c212e;hp=fedf769a55327ed9ab34e93a46319b470b4f29d8;hpb=f5ee065fc247b81091cbdb96847cbe465a53d12a;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index fedf769..17826b1 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -1,37 +1,29 @@ package Mouse::Util::TypeConstraints; -use strict; -use warnings; - -use Exporter; +use Mouse::Util qw(does_role not_supported); # enables strict and warnings use Carp qw(confess); use Scalar::Util qw/blessed looks_like_number openhandle/; -use Mouse::Util qw(does_role not_supported); -use Mouse::Meta::Module; # class_of use Mouse::Meta::TypeConstraint; +use Mouse::Exporter; -use constant _DEBUG => !!$ENV{TC_DEBUG}; +Mouse::Exporter->setup_import_methods( + as_is => [qw( + as where message optimize_as + from via + type subtype coerce class_type role_type enum + find_type_constraint + )], -our @ISA = qw(Exporter); -our @EXPORT = qw( - as where message from via type subtype coerce class_type role_type enum - find_type_constraint + _export_to_main => 1, ); my %TYPE; -my %COERCE; -my %COERCE_KEYS; -sub as ($) { - return(as => $_[0]); -} -sub where (&) { - return(where => $_[0]) -} -sub message (&) { - return(message => $_[0]) -} +sub as ($) { (as => $_[0]) } +sub where (&) { (where => $_[0]) } +sub message (&) { (message => $_[0]) } +sub optimize_as (&) { (optimize_as => $_[0]) } sub from { @_ } sub via (&) { $_[0] } @@ -72,13 +64,12 @@ BEGIN { while (my ($name, $code) = each %builtins) { $TYPE{$name} = Mouse::Meta::TypeConstraint->new( - name => $name, - _compiled_type_constraint => $code, - package_defined_in => __PACKAGE__, + name => $name, + optimized => $code, ); } - sub optimized_constraints { + sub optimized_constraints { # DEPRECATED Carp::cluck('optimized_constraints() has been deprecated'); return \%TYPE; } @@ -116,6 +107,14 @@ sub _create_type{ } $args{name} = $name; + my $parent; + if($mode eq 'subtype'){ + $parent = delete $args{as}; + if(!$parent){ + $parent = delete $args{name}; + $name = '__ANON__'; + } + } my $package_defined_in = $args{package_defined_in} ||= caller(1); @@ -125,17 +124,12 @@ sub _create_type{ . "$existing->{package_defined_in} and cannot be created again in $package_defined_in"); } - $args{constraint} = delete($args{where}) - if exists $args{where}; - $args{_compiled_type_constraint} = delete $args{optimized_as} - if exists $args{optimized_as}; + $args{constraint} = delete $args{where} if exists $args{where}; + $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as}; my $constraint; if($mode eq 'subtype'){ - my $parent = exists($args{as}) ? delete($args{as}) : delete($args{name}); - - $parent = blessed($parent) ? $parent : find_or_create_isa_type_constraint($parent); - $constraint = $parent->create_child_type(%args); + $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args); } else{ $constraint = Mouse::Meta::TypeConstraint->new(%args); @@ -153,35 +147,12 @@ sub subtype { } sub coerce { - my $name = shift; - - $name =~ s/\s+//g; - confess "Cannot find type '$name', perhaps you forgot to load it." - unless $TYPE{$name}; - - unless ($COERCE{$name}) { - $COERCE{$name} = {}; - $COERCE_KEYS{$name} = []; - } - - my $package_defined_in = caller; + my $type_name = shift; - while (my($from, $code) = splice @_, 0, 2) { - $from =~ s/\s+//g; + my $type = find_type_constraint($type_name) + or confess("Cannot find type '$type_name', perhaps you forgot to load it."); - confess "A coercion action already exists for '$from'" - if $COERCE{$name}->{$from}; - - my $type = find_or_parse_type_constraint($from, $package_defined_in); - if (!$type) { - confess "Could not find the type constraint ($from) to coerce from" - } - - warn "# REGISTER COERCE $name, from $type\n" if _DEBUG; - - push @{ $COERCE_KEYS{$name} }, $type; - $COERCE{$name}->{$from} = $code; - } + $type->_add_type_coercions(@_); return; } @@ -215,36 +186,13 @@ sub role_type { ); } -# this is an original method for Mouse -sub typecast_constraints { - my($class, $pkg, $types, $value) = @_; +sub typecast_constraints { # DEPRECATED + my($class, $pkg, $type, $value) = @_; Carp::croak("wrong arguments count") unless @_ == 4; - local $_; - for my $type ($types, ($types->{type_constraints} ? @{$types->{type_constraints}} : ()) ) { - for my $coerce_type (@{ $COERCE_KEYS{$type}}) { - - if(_DEBUG){ - warn sprintf "# COERCE: from %s to %s for %s (%s)\n", - $coerce_type, $type, defined($value) ? $value : 'undef', - $coerce_type->check($value) ? "try" : "skip"; - } - - next if !$coerce_type->check($value); - - # try to coerce - $_ = $value; - $_ = $COERCE{$type}->{$coerce_type}->($_); # coerce - - if(_DEBUG){ - warn sprintf "# COERCE: got %s, which is%s %s\n", - defined($_) ? $_ : 'undef', $types->check($_) ? '' : ' not', $types; - } + Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway"); - return $_ if $types->check($_); # check for $types, not $constraint - } - } - return $value; + return $type->coerce($value); } sub enum { @@ -272,7 +220,7 @@ sub _find_or_create_regular_type{ return $TYPE{$spec} if exists $TYPE{$spec}; - my $meta = Mouse::Meta::Module::class_of($spec); + my $meta = Mouse::Util::get_metaclass_by_name($spec); if(!$meta){ return; @@ -280,7 +228,7 @@ sub _find_or_create_regular_type{ my $check; my $type; - if($meta && $meta->isa('Mouse::Meta::Role')){ + if($meta->isa('Mouse::Meta::Role')){ $check = sub{ return blessed($_[0]) && $_[0]->does($spec); }; @@ -293,19 +241,17 @@ sub _find_or_create_regular_type{ $type = 'Class'; } - warn "#CREATE a $type type for $spec\n" if _DEBUG; - return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( - name => $spec, - _compiled_type_constraint => $check, + name => $spec, + optimized => $check, - type => $type, + type => $type, ); } $TYPE{ArrayRef}{constraint_generator} = sub { my($type_parameter) = @_; - my $check = $type_parameter->{_compiled_type_constraint}; + my $check = $type_parameter->_compiled_type_constraint; return sub{ foreach my $value (@{$_}) { @@ -316,7 +262,7 @@ $TYPE{ArrayRef}{constraint_generator} = sub { }; $TYPE{HashRef}{constraint_generator} = sub { my($type_parameter) = @_; - my $check = $type_parameter->{_compiled_type_constraint}; + my $check = $type_parameter->_compiled_type_constraint; return sub{ foreach my $value(values %{$_}){ @@ -329,7 +275,7 @@ $TYPE{HashRef}{constraint_generator} = sub { # 'Maybe' type accepts 'Any', so it requires parameters $TYPE{Maybe}{constraint_generator} = sub { my($type_parameter) = @_; - my $check = $type_parameter->{_compiled_type_constraint}; + my $check = $type_parameter->_compiled_type_constraint; return sub{ return !defined($_) || $check->($_); @@ -342,8 +288,6 @@ sub _find_or_create_parameterized_type{ my $name = sprintf '%s[%s]', $base->name, $param->name; $TYPE{$name} ||= do{ - warn "#CREATE a Parameterized type for $name\n" if _DEBUG; - my $generator = $base->{constraint_generator}; if(!$generator){ @@ -360,26 +304,16 @@ sub _find_or_create_parameterized_type{ } } sub _find_or_create_union_type{ - my @types = map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_; + my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_; - my $name = join '|', map{ $_->name } @types; + my $name = join '|', @types; $TYPE{$name} ||= do{ - warn "# CREATE a Union type for ", Mouse::Util::english_list(@types),"\n" if _DEBUG; - - my $check = sub{ - foreach my $type(@types){ - return 1 if $type->check($_[0]); - } - return 0; - }; - return Mouse::Meta::TypeConstraint->new( - name => $name, - _compiled_type_constraint => $check, - type_constraints => \@types, + name => $name, + type_constraints => \@types, - type => 'Union', + type => 'Union', ); }; } @@ -398,7 +332,7 @@ sub _parse_type{ my $char = substr($spec, $i, 1); if($char eq '['){ - my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start)) + my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) ) or return; ($i, $subtype) = _parse_type($spec, $i+1) @@ -412,8 +346,12 @@ sub _parse_type{ last; } elsif($char eq '|'){ - my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start)) - or return; + my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) ); + + if(!defined $type){ + # XXX: Mouse creates a new class type, but Moose does not. + $type = class_type( substr($spec, $start, $i - $start) ); + } push @list, $type; @@ -426,7 +364,16 @@ sub _parse_type{ } } if($i - $start){ - push @list, _find_or_create_regular_type(substr $spec, $start, $i - $start); + my $type = _find_or_create_regular_type( substr $spec, $start, $i - $start ); + + if(defined $type){ + push @list, $type; + } + elsif($start != 0) { + # RT #50421 + # create a new class type + push @list, class_type( substr $spec, $start, $i - $start ); + } } if(@list == 0){ @@ -443,7 +390,7 @@ sub _parse_type{ sub find_type_constraint { my($spec) = @_; - return $spec if blessed($spec); + return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint'); $spec =~ s/\s+//g; return $TYPE{$spec}; @@ -451,8 +398,7 @@ sub find_type_constraint { sub find_or_parse_type_constraint { my($spec) = @_; - - return $spec if blessed($spec); + return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint'); $spec =~ s/\s+//g; return $TYPE{$spec} || do{ @@ -462,12 +408,7 @@ sub find_or_parse_type_constraint { } sub find_or_create_does_type_constraint{ - my $type = find_or_parse_type_constriant(@_) || role_type(@_); - - if($type->{type} && $type->{type} ne 'Role'){ - Carp::cluck("$type is not a role type"); - } - return $type; + return find_or_parse_type_constraint(@_) || role_type(@_); } sub find_or_create_isa_type_constraint { @@ -482,6 +423,10 @@ __END__ Mouse::Util::TypeConstraints - Type constraint system for Mouse +=head1 VERSION + +This document describes Mouse version 0.38 + =head2 SYNOPSIS use Mouse::Util::TypeConstraints; @@ -569,7 +514,6 @@ that hierarchy represented visually. GlobRef FileHandle Object - Role B Any type followed by a type parameter C<[`a]> can be parameterized, this means you can say: @@ -642,9 +586,13 @@ related C function. =head1 METHODS -=head2 optimized_constraints -> HashRef[CODE] +=head2 C<< list_all_builtin_type_constraints -> (Names) >> + +Returns the names of builtin type constraints. + +=head2 C<< list_all_type_constraints -> (Names) >> -Returns the simple type constraints that Mouse understands. +Returns the names of all the type constraints. =head1 FUNCTIONS