X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints%2FOptimizedConstraints.pm;h=4bd82528873a96aa1121675c8759c6babb4479ca;hb=f4b86ac0e1fd7ff8a180f2f8332821170db5371e;hp=d033a75c21246a693ecc9f9f02f239df153e38a1;hpb=c8a26288b5f3f115cfa55ec0b97c98d6f58cdc49;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm index d033a75..4bd8252 100644 --- a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm +++ b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm @@ -3,9 +3,11 @@ package Moose::Util::TypeConstraints::OptimizedConstraints; use strict; use warnings; +use Class::MOP; +use Moose::Deprecated; use Scalar::Util 'blessed', 'looks_like_number'; -our $VERSION = '0.69'; +our $VERSION = '1.16'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -13,13 +15,23 @@ sub Value { defined($_[0]) && !ref($_[0]) } sub Ref { ref($_[0]) } -sub Str { defined($_[0]) && !ref($_[0]) } +# We need to use a temporary here to flatten LVALUEs, for instance as in +# Str(substr($_,0,255)). +sub Str { + my $value = $_[0]; + defined($value) && ref(\$value) eq 'SCALAR' +} sub Num { !ref($_[0]) && looks_like_number($_[0]) } -sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ } +# using a temporary here because regex matching promotes an IV to a PV, +# and that confuses some things (like JSON.pm) +sub Int { + my $value = $_[0]; + defined($value) && !ref($value) && $value =~ /^-?[0-9]+$/ +} -sub ScalarRef { ref($_[0]) eq 'SCALAR' } +sub ScalarRef { ref($_[0]) eq 'SCALAR' || ref($_[0]) eq 'REF' } sub ArrayRef { ref($_[0]) eq 'ARRAY' } sub HashRef { ref($_[0]) eq 'HASH' } sub CodeRef { ref($_[0]) eq 'CODE' } @@ -30,39 +42,22 @@ sub FileHandle { ref($_[0]) eq 'GLOB' && Scalar::Util::openhandle($_[0]) or bles sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' } -sub Role { blessed($_[0]) && $_[0]->can('does') } +sub Role { + Moose::Deprecated::deprecated( + feature => 'Role type', + message => + 'The Role type has been deprecated. Maybe you meant to create a RoleName type?' + ); + blessed( $_[0] ) && $_[0]->can('does'); +} sub ClassName { - return 0 if ref($_[0]) || !defined($_[0]) || !length($_[0]); - - # walk the symbol table tree to avoid autovififying - # \*{${main::}{"Foo::"}} == \*main::Foo:: - - my $pack = \*::; - foreach my $part (split('::', $_[0])) { - return 0 unless exists ${$$pack}{"${part}::"}; - $pack = \*{${$$pack}{"${part}::"}}; - } - - # check for $VERSION or @ISA - return 1 if exists ${$$pack}{VERSION} - && defined *{${$$pack}{VERSION}}{SCALAR}; - return 1 if exists ${$$pack}{ISA} - && defined *{${$$pack}{ISA}}{ARRAY}; - - # check for any method - foreach ( keys %{$$pack} ) { - next if substr($_, -2, 2) eq '::'; - return 1 if defined *{${$$pack}{$_}}{CODE}; - } - - # fail - return 0; + return Class::MOP::is_class_loaded( $_[0] ); } sub RoleName { - ClassName($_[0]) - && (($_[0]->can('meta') || return)->($_[0]) || return)->isa('Moose::Meta::Role') + ClassName($_[0]) + && (Class::MOP::class_of($_[0]) || return)->isa('Moose::Meta::Role') } # NOTE: @@ -83,7 +78,7 @@ bodies for various moose types =head1 DESCRIPTION -This file contains the hand optimized versions of Moose type constraints, +This file contains the hand optimized versions of Moose type constraints, no user serviceable parts inside. =head1 FUNCTIONS @@ -126,9 +121,7 @@ no user serviceable parts inside. =head1 BUGS -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +See L for details on reporting bugs. =head1 AUTHOR