*check_package_cache_flag = \&mro::get_pkg_gen;
}
-our $VERSION = '0.67';
+our $VERSION = '0.72';
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
# because I don't yet see a good reason to do so.
}
-sub load_one_class_of {
- use List::Util qw/first/;
- my @classes = @_;
+sub load_first_existing_class {
+ my @classes = @_
+ or return;
foreach my $class (@classes) {
unless ( _is_valid_class_name($class) ) {
}
}
+ my $found;
my %exceptions;
- my $name = first {
- return $_ if is_class_loaded($_);
- # require it
- my $file = $_ . '.pm';
- $file =~ s{::}{/}g;
- my $e = do { local $@; eval { require($file) }; $@ };
+ for my $class (@classes) {
+ my $e = _try_load_one_class($class);
+
if ($e) {
- $exceptions{$_} = $e;
- return;
+ $exceptions{$class} = $e;
}
else {
- return $_;
+ $found = $class;
+ last;
}
- } @classes;
-
- if ($name) {
- return get_metaclass_by_name($name) || $name;
}
- # Could load no classes.
- confess join("\n",
- map { sprintf("Could not load class (%s) because : %s", $_, $exceptions{$_}) } @classes
- ) if keys %exceptions;
+ return $found if $found;
+
+ confess join(
+ "\n",
+ map {
+ sprintf(
+ "Could not load class (%s) because : %s", $_,
+ $exceptions{$_}
+ )
+ } @classes
+ );
+}
+
+sub _try_load_one_class {
+ my $class = shift;
+
+ return if is_class_loaded($class);
+
+ my $file = $class . '.pm';
+ $file =~ s{::}{/}g;
+
+ return do {
+ local $@;
+ eval { require($file) };
+ $@;
+ };
}
sub load_class {
- load_one_class_of($_[0]);
+ my $class = load_first_existing_class($_[0]);
+ return get_metaclass_by_name($class) || $class;
}
sub _is_valid_class_name {
sub is_class_loaded {
my $class = shift;
- return 0 if ref($class) || !defined($class) || !length($class);
+ return 0 unless _is_valid_class_name($class);
# walk the symbol table tree to avoid autovififying
# \*{${main::}{"Foo::"}} == \*main::Foo::
## --------------------------------------------------------
## Now close all the Class::MOP::* classes
-# NOTE:
-# we don't need to inline the
-# constructors or the accessors
-# this only lengthens the compile
-# time of the MOP, and gives us
-# no actual benefits.
+# NOTE: we don't need to inline the the accessors this only lengthens
+# the compile time of the MOP, and gives us no actual benefits.
$_->meta->make_immutable(
inline_constructor => 1,
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
Otherwise it's a constant returning false.
+=item B<load_first_existing_class ($class_name, [$class_name, ...])>
+
+B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
+
+Given a list of class names, this function will attempt to load each
+one in turn.
+
+If it finds a class it can load, it will return that class' name.
+If none of the classes can be loaded, it will throw an exception.
+
=back
=head2 Metaclass cache functions