From: Stevan Little <stevan.little@iinteractive.com>
Date: Sat, 24 Feb 2007 23:18:01 +0000 (+0000)
Subject: added some functions to check if class is loaded and to load them (stolen from Moose... 
X-Git-Tag: 0_37^0
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=448b6e55bd0b67cf4cc1c17147b9fba68eb0e042;p=gitmo%2FClass-MOP.git

added some functions to check if class is loaded and to load them (stolen from Moose.pm actually)
---

diff --git a/Changes b/Changes
index 10056fa..f152c47 100644
--- a/Changes
+++ b/Changes
@@ -1,7 +1,11 @@
 Revision history for Perl extension Class-MOP.
 
 0.37
-    ~~ Many documentation updates ~~
+    ~~ Many, many documentation updates ~~
+    
+    * Class::MOP
+      - added &load_class and &is_class_loaded 
+        - added tests and docs for these
 
     * Class::MOP::Attribute
       - default now checks the instance with defined to 
diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index c7cd2fe..3e61675 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -41,6 +41,35 @@ our $AUTHORITY = 'cpan:STEVAN';
     # because I don't yet see a good reason to do so.        
 }
 
+sub load_class {
+    my $class = shift;
+    # see if this is already 
+    # loaded in the symbol table
+    return 1 if is_class_loaded($class);
+    # otherwise require it ...
+    my $file = $class . '.pm';
+    $file =~ s{::}{/}g;
+    eval { CORE::require($file) };
+    confess "Could not load class ($class) because : $@" if $@;
+    unless (does_metaclass_exist($class)) {
+        eval { Class::MOP::Class->initialize($class) };
+        confess "Could not initialize class ($class) because : $@" if $@;        
+    }
+    1; # return true if it worked
+}
+
+sub is_class_loaded {
+	my $class = shift;
+	no strict 'refs';
+	return 1 if defined ${"${class}::VERSION"} || defined @{"${class}::ISA"};
+	foreach (keys %{"${class}::"}) {
+		next if substr($_, -2, 2) eq '::';
+		return 1 if defined &{"${class}::$_"};
+	}
+	return 0;
+}
+
+
 ## ----------------------------------------------------------------------------
 ## Setting up our environment ...
 ## ----------------------------------------------------------------------------
@@ -665,6 +694,28 @@ See L<Class::MOP::Method> for more details.
 
 =head1 FUNCTIONS
 
+=head2 Utility functions
+
+=over 4
+
+=item B<load_class ($class_name)>
+
+This will load a given C<$class_name> and if it does not have an 
+already initialized metaclass, then it will intialize one for it.
+
+=item B<is_class_loaded ($class_name)>
+
+This will return a boolean depending on if the C<$class_name> has 
+been loaded. 
+
+NOTE: This does a basic check of the symbol table to try and 
+determine as best it can if the C<$class_name> is loaded, it
+is probably correct about 99% of the time. 
+
+=back
+
+=head2 Metaclass cache functions
+
 Class::MOP holds a cache of metaclasses, the following are functions 
 (B<not methods>) which can be used to access that cache. It is not 
 recommended that you mess with this, bad things could happen. But if 
diff --git a/t/000_load.t b/t/000_load.t
index 324ff6b..dd828c9 100644
--- a/t/000_load.t
+++ b/t/000_load.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 29;
+use Test::More tests => 39;
 
 BEGIN {
     use_ok('Class::MOP');
@@ -37,6 +37,8 @@ my %METAS = (
     'Class::MOP::Object'              => Class::MOP::Object->meta,  
 );
 
+ok(Class::MOP::is_class_loaded($_), '... ' . $_ . ' is loaded') for keys %METAS;
+
 ok($_->is_immutable(), '... ' . $_->name . ' is immutable') for values %METAS;
 
 is_deeply(
diff --git a/t/100_BinaryTree_test.t b/t/100_BinaryTree_test.t
index 08e2945..704fd4d 100644
--- a/t/100_BinaryTree_test.t
+++ b/t/100_BinaryTree_test.t
@@ -3,17 +3,30 @@
 use strict;
 use warnings;
 
-use Test::More tests => 68;
+use FindBin;
+use File::Spec::Functions;
+
+use Test::More tests => 70;
+use Test::Exception;
 
 BEGIN { 
     use_ok('Class::MOP');    
-    use_ok('t::lib::BinaryTree');
 }
 
+use lib catdir($FindBin::Bin, 'lib');
+
 ## ----------------------------------------------------------------------------
 ## These are all tests which are derived from the Tree::Binary test suite
 ## ----------------------------------------------------------------------------
 
+ok(!Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is not loaded');
+
+lives_ok {
+    Class::MOP::load_class('BinaryTree');
+} '... loaded the BinaryTree class without dying';
+
+ok(Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is now loaded');
+
 ## ----------------------------------------------------------------------------
 ## t/10_Tree_Binary_test.t