use Carp 'confess';
use Scalar::Util 'weaken', 'reftype', 'blessed';
+use Data::OptList;
use Try::Tiny;
use Class::MOP::Mixin::AttributeCore;
}
sub load_first_existing_class {
- my @classes = @_
+ my $classes = Data::OptList::mkopt(\@_)
or return;
- foreach my $class (@classes) {
- unless ( _is_valid_class_name($class) ) {
- my $display = defined($class) ? $class : 'undef';
+ foreach my $class (@{ $classes }) {
+ my $name = $class->[0];
+ unless ( _is_valid_class_name($name) ) {
+ my $display = defined($name) ? $name : 'undef';
confess "Invalid class name ($display)";
}
}
my $found;
my %exceptions;
- for my $class (@classes) {
- my $file = _class_to_pmfile($class);
+ for my $class (@{ $classes }) {
+ my ($name, $options) = @{ $class };
- return $class if is_class_loaded($class);;
+ if ($options) {
+ return $name if is_class_loaded($name, $options);
+ if (is_class_loaded($name)) {
+ # we already know it's loaded and too old, but we call
+ # ->VERSION anyway to generate the exception for us
+ $name->VERSION($options->{-version});
+ }
+ }
+ else {
+ return $name if is_class_loaded($name);
+ }
- return $class if try {
+ my $file = _class_to_pmfile($name);
+ return $name if try {
local $SIG{__DIE__};
require $file;
+ $name->VERSION($options->{-version})
+ if defined $options->{-version};
return 1;
}
catch {
unless (/^Can't locate \Q$file\E in \@INC/) {
- confess "Couldn't load class ($class) because: $_";
+ confess "Couldn't load class ($name) because: $_";
}
return;
};
}
- if ( @classes > 1 ) {
- confess "Can't locate any of @classes in \@INC (\@INC contains: @INC).";
+ if ( @{ $classes } > 1 ) {
+ my @list = map { $_->[0] } @{ $classes };
+ confess "Can't locate any of @list in \@INC (\@INC contains: @INC).";
} else {
- confess "Can't locate " . _class_to_pmfile($classes[0]) . " in \@INC (\@INC contains: @INC).";
+ confess "Can't locate " . _class_to_pmfile($classes->[0]->[0]) . " in \@INC (\@INC contains: @INC).";
}
}
sub load_class {
- load_first_existing_class($_[0]);
+ load_first_existing_class($_[0], ref $_[1] ? $_[1] : ());
# This is done to avoid breaking code which checked the return value. Said
# code is dumb. The return value was _always_ true, since it dies on
=over 4
-=item B<Class::MOP::load_class($class_name)>
+=item B<Class::MOP::load_class($class_name, \%options?)>
This will load the specified C<$class_name>, if it is not already
loaded (as reported by C<is_class_loaded>). This function can be used
If the module cannot be loaded, an exception is thrown.
+You can pass a hash reference with options as second argument. The
+only option currently recognised is C<-version>, which will ensure
+that the loaded class has at least the required version.
+
+See also L</Class Loading Options>.
+
For historical reasons, this function explicitly returns a true value.
-=item B<Class::MOP::is_class_loaded($class_name)>
+=item B<Class::MOP::is_class_loaded($class_name, \%options?)>
Returns a boolean indicating whether or not C<$class_name> has been
loaded.
cause most of the rest of the core L<IO> modules to falsely report
having been loaded, due to the way the base L<IO> module works.
+You can pass a hash reference with options as second argument. The
+only option currently recognised is C<-version>, which will ensure
+that the loaded class has at least the required version.
+
+See also L</Class Loading Options>.
+
=item B<Class::MOP::get_code_info($code)>
This function returns two values, the name of the package the C<$code>
=item B<Class::MOP::load_first_existing_class(@class_names)>
+=item B<Class::MOP::load_first_existing_class($classA, \%optionsA?, $classB, ...)>
+
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
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.
+Additionally, you can pass a hash reference with options after each
+class name. Currently, only C<-version> is recognised and will ensure
+that the loaded class has at least the required version. If the class
+version is not sufficient, an exception will be raised.
+
+See also L</Class Loading Options>.
+
=back
=head2 Metaclass cache functions
=back
+=head2 Class Loading Options
+
+=over 4
+
+=item -version
+
+Can be used to pass a minimum required version that will be checked
+against the class version after it was loaded.
+
+=back
+
=head1 SEE ALSO
=head2 Books
'an @ISA with members does mean a class is loaded' );
}
+{
+ {
+ package Class::WithVersion;
+ our $VERSION = 23;
+ };
+
+ ok( Class::MOP::is_class_loaded('Class::WithVersion', { -version => 13 }),
+ 'version 23 satisfies version requirement 13' );
+
+ ok( !Class::MOP::is_class_loaded('Class::WithVersion', { -version => 42 }),
+ 'version 23 does not satisfy version requirement 42' );
+
+ throws_ok {
+ Class::MOP::load_first_existing_class('Affe', 'Tiger', 'Class::WithVersion' => { -version => 42 });
+ } qr/Class::WithVersion version 42 required--this is only version 23/,
+ 'load_first_existing_class gives correct exception on old version';
+
+ lives_ok {
+ Class::MOP::load_first_existing_class('Affe', 'Tiger', 'Class::WithVersion' => { -version => 13 });
+ } 'loading class with required version with load_first_existing_class';
+
+ throws_ok {
+ Class::MOP::load_class('Class::WithVersion' => { -version => 42 });
+ } qr/Class::WithVersion version 42 required--this is only version 23/,
+ 'load_class gives correct exception on old version';
+
+ lives_ok {
+ Class::MOP::load_class('Class::WithVersion' => { -version => 13 });
+ } 'loading class with required version with load_class';
+
+}
+
done_testing;
return FALSE;
}
+static bool
+check_version (SV *klass, SV *required_version)
+{
+ bool ret = 0;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ EXTEND(SP, 2);
+ PUSHs(klass);
+ PUSHs(required_version);
+ PUTBACK;
+
+ call_method("VERSION", G_DISCARD|G_VOID|G_EVAL);
+
+ SPAGAIN;
+
+ if (!SvTRUE(ERRSV)) {
+ ret = 1;
+ }
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ return ret;
+}
+
EXTERN_C XS(boot_Class__MOP__Mixin__HasMethods);
EXTERN_C XS(boot_Class__MOP__Package);
EXTERN_C XS(boot_Class__MOP__Mixin__AttributeCore);
}
void
-is_class_loaded(klass)
+is_class_loaded(klass, options=NULL)
SV *klass
+ HV *options
PREINIT:
HV *stash;
bool found_method = FALSE;
XSRETURN_NO;
}
+ if (options && hv_exists_ent(options, KEY_FOR(_version), HASH_FOR(_version))) {
+ HE *required_version = hv_fetch_ent(options, KEY_FOR(_version), 0, HASH_FOR(_version));
+ if (check_version (klass, HeVAL(required_version))) {
+ XSRETURN_YES;
+ }
+
+ XSRETURN_NO;
+ }
+
if (hv_exists_ent (stash, KEY_FOR(VERSION), HASH_FOR(VERSION))) {
HE *version = hv_fetch_ent(stash, KEY_FOR(VERSION), 0, HASH_FOR(VERSION));
SV *version_sv;
projects / gitmo/Class-MOP.git / commitdiff