From: Shawn M Moore <sartak@gmail.com>
Date: Tue, 10 Jun 2008 04:39:45 +0000 (+0000)
Subject: Move the ClassName type check code to Class::MOP::is_class_loaded
X-Git-Tag: 0_55~121
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e151db232f0c663f96d6bb9c32da38c8f784a32d;p=gitmo%2FMoose.git

Move the ClassName type check code to Class::MOP::is_class_loaded
---

diff --git a/Changes b/Changes
index 42243e9..f875682 100644
--- a/Changes
+++ b/Changes
@@ -28,6 +28,10 @@ Revision history for Perl extension Moose
         can be overrided in subclasses (thanks to Sartak)
         - added test for this (thanks to Sartak)
 
+    * Moose::Util::TypeConstraints
+      - move the ClassName type check code to
+        Class::MOP::is_class_loaded (thanks to Sartak)
+
 0.48 Thurs. May 29, 2008
     (early morning release engineering)--
 
diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 9e3a832..96d3ab1 100644
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -558,38 +558,12 @@ subtype 'Role'
     => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role;
 
 my $_class_name_checker = sub {
-    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;
 };
 
 subtype 'ClassName'
     => as 'Str'
-    => $_class_name_checker # where ...
-    => { optimize => $_class_name_checker };
+    => where { Class::MOP::is_class_loaded($_) }
+    => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName;
 
 ## --------------------------------------------------------
 # parameterizable types ...
diff --git a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
index 3ad1f88..ef49088 100644
--- a/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm
@@ -34,6 +34,34 @@ sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' }
 
 sub Role { 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;
+}
+
 # NOTE:
 # we have XS versions too, ...
 # 04:09 <@konobi> nothingmuch: konobi.co.uk/code/utilsxs.tar.gz
@@ -87,6 +115,8 @@ no user serviceable parts inside.
 
 =item Role
 
+=item ClassName
+
 =back
 
 =head1 BUGS