fix ClassName constraint to use symbol table

[gitmo/Moose.git] / lib / Moose / Util / TypeConstraints.pm

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 807e61a..44690df 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -411,8 +411,61 @@ subtype 'Role'
 
 subtype 'ClassName'
     => as 'Str'
-    => where { eval { $_->isa('UNIVERSAL') } }
-    => optimize_as { !ref($_[0]) && eval { $_[0]->isa('UNIVERSAL') } };
+    => where {
+         return unless defined($_) && length($_);
+
+         # walk the symbol table tree to avoid autovififying
+         # \*{${main::}{"Foo::"}} == \*main::Foo::
+
+         my $pack = \*::;
+         foreach my $part (split('::', $_)) {
+           return 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;
+       }
+    => optimize_as {
+         return if ref($_[0]);
+         return unless defined($_[0]) && length($_[0]);
+
+         # walk the symbol table tree to avoid autovififying
+         # \*{${main::}{"Foo::"}} == \*main::Foo::
+
+         my $pack = \*::;
+         foreach my $part (split('::', $_[0])) {
+           return 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;
+       };
 
 ## --------------------------------------------------------
 # end of built-in types ...