X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=ef0751d11330d2c96b1aa63b94db71814873f7a5;hp=9582efda8949e299975dd4094c3967c0dd4584e6;hb=1d5ecd5f15a0f418bee471c00af2357ba63b99ba;hpb=98ab51333533a85f044f893160daaf525fb6da2c diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index 9582efd..ef0751d 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -1,32 +1,27 @@ 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::TypeConstraint; - -our @ISA = qw(Exporter); -our @EXPORT = qw( - as where message from via type subtype coerce class_type role_type enum - find_type_constraint +use Mouse::Exporter; + +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 + )], ); my %TYPE; -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] } @@ -37,32 +32,28 @@ BEGIN { Item => undef, # null check Maybe => undef, # null check - Bool => sub { $_[0] ? $_[0] eq '1' : 1 }, - Undef => sub { !defined($_[0]) }, - Defined => sub { defined($_[0]) }, - Value => sub { defined($_[0]) && !ref($_[0]) }, - Num => sub { !ref($_[0]) && looks_like_number($_[0]) }, - Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ }, - Str => sub { defined($_[0]) && !ref($_[0]) }, - Ref => sub { ref($_[0]) }, - - ScalarRef => sub { ref($_[0]) eq 'SCALAR' }, - ArrayRef => sub { ref($_[0]) eq 'ARRAY' }, - HashRef => sub { ref($_[0]) eq 'HASH' }, - CodeRef => sub { ref($_[0]) eq 'CODE' }, - RegexpRef => sub { ref($_[0]) eq 'Regexp' }, - GlobRef => sub { ref($_[0]) eq 'GLOB' }, - - FileHandle => sub { - ref($_[0]) eq 'GLOB' && openhandle($_[0]) - or - blessed($_[0]) && $_[0]->isa("IO::Handle") - }, - - Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' }, - - ClassName => sub { Mouse::Util::is_class_loaded($_[0]) }, - RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') }, + Bool => \&Bool, + Undef => \&Undef, + Defined => \&Defined, + Value => \&Value, + Num => \&Num, + Int => \&Int, + Str => \&Str, + Ref => \&Ref, + + ScalarRef => \&ScalarRef, + ArrayRef => \&ArrayRef, + HashRef => \&HashRef, + CodeRef => \&CodeRef, + RegexpRef => \&RegexpRef, + GlobRef => \&GlobRef, + + FileHandle => \&FileHandle, + + Object => \&Object, + + ClassName => \&ClassName, + RoleName => \&RoleName, ); while (my ($name, $code) = each %builtins) { @@ -110,6 +101,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); @@ -119,14 +118,11 @@ 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{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 = delete($args{as}) - or confess('A subtype cannot consist solely of a name, it must have a parent'); - $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args); } else{ @@ -159,15 +155,16 @@ sub class_type { if ($conf && $conf->{class}) { # No, you're using this wrong warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?"; - _create_type 'type', $name => ( + _create_type 'subtype', $name => ( as => $conf->{class}, type => 'Class', ); } else { - _create_type 'type', $name => ( - optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) }, + _create_type 'subtype', $name => ( + as => 'Object', + optimized_as => _generate_class_type_for($name), type => 'Class', ); @@ -177,7 +174,8 @@ sub class_type { sub role_type { my($name, $conf) = @_; my $role = ($conf && $conf->{role}) ? $conf->{role} : $name; - _create_type 'type', $name => ( + _create_type 'subtype', $name => ( + as => 'Object', optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) }, type => 'Role', @@ -224,27 +222,12 @@ sub _find_or_create_regular_type{ return; } - my $check; - my $type; if($meta->isa('Mouse::Meta::Role')){ - $check = sub{ - return blessed($_[0]) && $_[0]->does($spec); - }; - $type = 'Role'; + return role_type($spec); } else{ - $check = sub{ - return blessed($_[0]) && $_[0]->isa($spec); - }; - $type = 'Class'; + return class_type($spec); } - - return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( - name => $spec, - optimized => $check, - - type => $type, - ); } $TYPE{ArrayRef}{constraint_generator} = sub { @@ -302,9 +285,9 @@ 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{ return Mouse::Meta::TypeConstraint->new( @@ -362,7 +345,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){ @@ -397,12 +389,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 { @@ -417,6 +404,10 @@ __END__ Mouse::Util::TypeConstraints - Type constraint system for Mouse +=head1 VERSION + +This document describes Mouse version 0.40_01 + =head2 SYNOPSIS use Mouse::Util::TypeConstraints;