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=56d4734a09c1c25414c7099e20c1616957d72e3e;hp=ce292dd0d8494104e6425b12e7c0fc1fc4262cfd;hb=9b9e4b6566015d6d6e2aa6c745644174efa74623;hpb=9561101934279716806723e80517866d71c3a0c7 diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index ce292dd..56d4734 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -1,35 +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; + +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] } @@ -75,7 +69,7 @@ BEGIN { ); } - sub optimized_constraints { + sub optimized_constraints { # DEPRECATED Carp::cluck('optimized_constraints() has been deprecated'); return \%TYPE; } @@ -113,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); @@ -122,14 +124,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{ @@ -187,7 +186,7 @@ sub role_type { ); } -sub typecast_constraints { +sub typecast_constraints { # DEPRECATED my($class, $pkg, $type, $value) = @_; Carp::croak("wrong arguments count") unless @_ == 4; @@ -221,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; @@ -305,9 +304,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( @@ -365,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){ @@ -400,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 { @@ -420,6 +423,10 @@ __END__ Mouse::Util::TypeConstraints - Type constraint system for Mouse +=head1 VERSION + +This document describes Mouse version 0.39 + =head2 SYNOPSIS use Mouse::Util::TypeConstraints;