From: Shawn M Moore Date: Tue, 10 Jun 2008 04:38:20 +0000 (+0000) Subject: Have is_class_loaded use the old code from Moose's ClassName type check X-Git-Tag: 0_64~32 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=26fcef27ce2ec8eff59fa576d97233e82fb4fe25;p=gitmo%2FClass-MOP.git Have is_class_loaded use the old code from Moose's ClassName type check --- diff --git a/Changes b/Changes index bab6c06..eb8be57 100644 --- a/Changes +++ b/Changes @@ -16,6 +16,9 @@ Revision history for Perl extension Class-MOP. * Class::MOP - MOP.xs does sanity checks on the coderef to avoid a segfault + - is_class_loaded check now uses code that + was improved in Moose's ClassName type + check * Class::MOP Class::MOP::Class diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index 88cd78a..92af82a 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -141,12 +141,31 @@ sub load_class { sub is_class_loaded { my $class = shift; - no strict 'refs'; - return 1 if defined ${"${class}::VERSION"} || defined @{"${class}::ISA"}; - foreach my $symbol (keys %{"${class}::"}) { - next if substr($symbol, -2, 2) eq '::'; - return 1 if defined &{"${class}::${symbol}"}; + + return 0 if ref($class) || !defined($class) || !length($class); + + # walk the symbol table tree to avoid autovififying + # \*{${main::}{"Foo::"}} == \*main::Foo:: + + my $pack = \*::; + foreach my $part (split('::', $class)) { + 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; }