X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=af5b8a0587cebd104232fed974def3849d419475;hb=5a592ad728880fb6a21e9610cbfeb1670f2053ab;hp=e05b870facd1ce7155b0c7d6b67419a7d5ba6ba6;hpb=7e0e6837dcef39d945629cb04d5f4d7619b08034;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index e05b870..af5b8a0 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -1,5 +1,5 @@ package Mouse::Util::TypeConstraints; -use Mouse::Util qw(does_role not_supported); # enables strict and warnings +use Mouse::Util; # enables strict and warnings use Carp (); use Scalar::Util (); @@ -150,9 +150,18 @@ sub _create_type{ if($TYPE{$name}){ my $that = $TYPE{$name}->{package_defined_in} || __PACKAGE__; - ($this eq $that) or Carp::croak( - "The type constraint '$name' has already been created in $that and cannot be created again in $this" - ); + if($this ne $that) { + my $note = ''; + if($that eq __PACKAGE__) { + $note = sprintf " ('%s' is %s type constraint)", + $name, + scalar(grep { $name eq $_ } list_all_builtin_type_constraints()) + ? 'a builtin' + : 'an implicitly created'; + } + Carp::croak("The type constraint '$name' has already been created in $that" + . " and cannot be created again in $this" . $note); + } } } else{ @@ -214,14 +223,17 @@ sub role_type { # RoleType return _create_type 'subtype', $name => ( as => 'Object', - optimized_as => sub { Scalar::Util::blessed($_[0]) && does_role($_[0], $role) }, + optimized_as => sub { + return Scalar::Util::blessed($_[0]) + && Mouse::Util::does_role($_[0], $role); + }, ); } sub duck_type { my($name, @methods); - if(!(@_ == 1 && ref($_[0]) eq 'ARRAY')){ + if(ref($_[0]) ne 'ARRAY'){ $name = shift; } @@ -231,6 +243,13 @@ sub duck_type { return _create_type 'subtype', $name => ( as => 'Object', optimized_as => Mouse::Util::generate_can_predicate_for(\@methods), + message => sub { + my($object) = @_; + my @missing = grep { !$object->can($_) } @methods; + return ref($object) + . ' is missing methods ' + . Mouse::Util::quoted_english_list(@missing); + }, ); } @@ -241,12 +260,15 @@ sub enum { $name = shift; } - %valid = map{ $_ => undef } (@_ == 1 && ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_); + %valid = map{ $_ => undef } + (@_ == 1 && ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_); # EnumType return _create_type 'subtype', $name => ( as => 'Str', - optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} }, + optimized_as => sub{ + return defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]}; + }, ); } @@ -361,8 +383,7 @@ sub _parse_type { sub find_type_constraint { my($spec) = @_; - return $spec if Mouse::Util::is_a_type_constraint($spec); - return undef if !defined $spec; + return $spec if Mouse::Util::is_a_type_constraint($spec) or not defined $spec; $spec =~ s/\s+//g; return $TYPE{$spec}; @@ -380,8 +401,7 @@ sub register_type_constraint { sub find_or_parse_type_constraint { my($spec) = @_; - return $spec if Mouse::Util::is_a_type_constraint($spec); - return undef if !defined $spec; + return $spec if Mouse::Util::is_a_type_constraint($spec) or not defined $spec; $spec =~ s/\s+//g; return $TYPE{$spec} || do{ @@ -417,7 +437,7 @@ Mouse::Util::TypeConstraints - Type constraint system for Mouse =head1 VERSION -This document describes Mouse version 0.63 +This document describes Mouse version 0.71 =head2 SYNOPSIS