X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints%2FOptimizedConstraints.pm;h=d6fe17e6a7bea8f4a439f7ec6eda48684baf17af;hb=6232ef492d4ed956c63d19bba3e14e2eaf13afa9;hp=035fcf7dd4744d248a88825f04cf9514a82c5f95;hpb=dc39b8509deeefd2204942516e4161ac10a2a38d;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm index 035fcf7..d6fe17e 100644 --- a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm +++ b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm @@ -3,9 +3,10 @@ package Moose::Util::TypeConstraints::OptimizedConstraints; use strict; use warnings; +use Class::MOP; use Scalar::Util 'blessed', 'looks_like_number'; -our $VERSION = '0.70'; +our $VERSION = '0.92'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -13,7 +14,7 @@ sub Value { defined($_[0]) && !ref($_[0]) } sub Ref { ref($_[0]) } -sub Str { defined($_[0]) && !ref($_[0]) } +sub Str { defined($_[0]) && ref(\$_[0]) eq 'SCALAR' } sub Num { !ref($_[0]) && looks_like_number($_[0]) } @@ -30,39 +31,15 @@ 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 { Carp::cluck('The Role type is deprecated.'); 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 +60,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,7 +103,7 @@ no user serviceable parts inside. =head1 BUGS -All complex software has bugs lurking in it, and this module is no +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.