Addition of load_one_class_of, to allow does method in Moose to be made quicker.

diff --git a/Changes b/Changes
index 9f311e5..ec492cb 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,9 +1,13 @@
 Revision history for Perl extension Class-MOP.
 
+0.68
     * Class::MOP
       - Make load_class require by file name instead of module name.
         This stops confusing error messages when loading '__PACKAGE__'.
         (Florian Ragwitz)
+      - Add load_one_class_of function to enable you to load one of a
+        list of classes, rather than having to call load_class multiple
+        times in an eval. (t0m)
 
 0.67 Tue October 14, 2008
     * Class::MOP::Class

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index f432ac1..0dde670 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -100,24 +100,45 @@ sub _load_pure_perl {
     # because I don't yet see a good reason to do so.
 }
 
-sub load_class {
-    my $class = shift;
-
-    unless ( _is_valid_class_name($class) ) {
-        my $display = defined($class) ? $class : 'undef';
-        confess "Invalid class name ($display)";
+sub load_one_class_of {
+    use List::Util qw/first/;
+    my @classes = @_;
+
+    foreach my $class (@classes) {
+        unless ( _is_valid_class_name($class) ) {
+            my $display = defined($class) ? $class : 'undef';
+            confess "Invalid class name ($display)";
+        }
     }
 
-    # if the class is not already loaded in the symbol table..
-    unless (is_class_loaded($class)) {
+    my %exceptions;
+    my $name = first {
+        return $_ if is_class_loaded($_);
         # require it
-        my $file = $class . '.pm';
+        my $file = $_ . '.pm';
         $file =~ s{::}{/}g;
         my $e = do { local $@; eval { require($file) }; $@ };
-        confess "Could not load class ($class) because : $e" if $e;
+        if ($e) {
+            $exceptions{$_} = $e;
+            return;
+        }
+        else {
+            return $_;
+        }
+    } @classes;
+
+    if ($name) {
+         return get_metaclass_by_name($name) || $name;
     }
 
-    get_metaclass_by_name($class) || $class if defined wantarray;
+    # Could load no classes.
+    confess join("\n", 
+        map { sprintf("Could not load class (%s) because : %s", $_, $exceptions{$_}) } @classes 
+    ) if keys %exceptions;
+}
+
+sub load_class {
+    load_one_class_of($_[0]);
 }
 
 sub _is_valid_class_name {
@@ -860,6 +881,14 @@ already initialized metaclass, then it will intialize one for it.
 This function can be used in place of tricks like 
 C<eval "use $module"> or using C<require>.
 
+=item B<load_one_class_of ($class_name, [$class_name, ...])>
+
+This will attempt to load the list of classes given as parameters.
+The first class successfully found or loaded will have it's metaclass
+initialized (if needed) and returned. Subsequent classes to the first
+loaded class will be ignored, and an exception will be thrown if none
+of the supplied class names can be loaded.
+
 =item B<is_class_loaded ($class_name)>
 
 This will return a boolean depending on if the C<$class_name> has

diff --git a/t/083_load_class.t b/t/083_load_class.t
index 1951cf5..38816e9 100644 (file)
--- a/t/083_load_class.t
+++ b/t/083_load_class.t
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 23;
+use Test::More tests => 27;
 use Test::Exception;
 
 require Class::MOP;
@@ -65,3 +65,13 @@ lives_ok {
 }
 
 isa_ok( Class::MOP::load_class("Lala"), "Class::MOP::Class", "when an object has a metaclass it is returned" );
+
+lives_ok {
+    isa_ok(Class::MOP::load_one_class_of("Lala", "Does::Not::Exist"), "Class::MOP::Class", 'Load_classes first param ok, metaclass returned');
+    isa_ok(Class::MOP::load_one_class_of("Does::Not::Exist", "Lala"), "Class::MOP::Class", 'Load_classes second param ok, metaclass returned');
+} 'load_classes works';
+throws_ok {
+    Class::MOP::load_one_class_of("Does::Not::Exist", "Also::Does::Not::Exist")
+} qr/Could not load class \(Does::Not::Exist.*Could not load class \(Also::Does::Not::Exist/s, 'Multiple non-existant classes cause exception';
+
+