Deprecate CMOP::{load_class, is_class_loaded, load_first_existing_class}

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 81f76b6..54bbd37 100644 (file)
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -9,6 +9,7 @@ use 5.008;
 use MRO::Compat;
 
 use Carp          'confess';
+use Class::Load   ();
 use Scalar::Util  'weaken', 'isweak', 'reftype', 'blessed';
 use Data::OptList;
 use Try::Tiny;
@@ -66,89 +67,25 @@ XSLoader::load(
     # because I don't yet see a good reason to do so.
 }
 
-sub _class_to_pmfile {
-    my $class = shift;
-
-    my $file = $class . '.pm';
-    $file =~ s{::}{/}g;
-
-    return $file;
+sub load_class {
+    Class::MOP::Deprecated::deprecated(
+              'The Class::MOP::load_class subroutine is deprecated.'
+            . ' Please use Class::Load instead.' );
+    goto &Class::Load::load_class;
 }
 
 sub load_first_existing_class {
-    my $classes = Data::OptList::mkopt(\@_)
-      or return;
-
-    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 ($name, $options) = @{ $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);
-        }
-
-        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 ($name) because: $_";
-            }
-
-            return;
-        };
-    }
-
-    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]->[0]) . " in \@INC (\@INC contains: @INC).";
-    }
-}
-
-sub load_class {
-    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
-    # failure!
-    return 1;
+    Class::MOP::Deprecated::deprecated(
+        'The Class::MOP::load_first_existing_class subroutine is deprecated.'
+            . ' Please use Class::Load instead.' );
+    goto &Class::Load::load_first_existing_class;
 }
 
-sub _is_valid_class_name {
-    my $class = shift;
-
-    return 0 if ref($class);
-    return 0 unless defined($class);
-    return 0 unless length($class);
-
-    return 1 if $class =~ /^\w+(?:::\w+)*$/;
-
-    return 0;
+sub is_class_loaded {
+    Class::MOP::Deprecated::deprecated(
+              'The Class::MOP::is_class_loaded subroutine is deprecated.'
+            . ' Please use Class::Load instead.' );
+    goto &Class::Load::is_class_loaded;
 }
 
 sub _definition_context {
@@ -989,37 +926,6 @@ Note that these are all called as B<functions, not methods>.
 
 =over 4
 
-=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
-in place of tricks like C<eval "use $module"> or using C<require>
-unconditionally.
-
-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 recognized is C<-version>, which will ensure
-that the loaded class has at least the required version.
-
-For historical reasons, this function explicitly returns a true value.
-
-=item B<Class::MOP::is_class_loaded($class_name, \%options?)>
-
-Returns a boolean indicating whether or not C<$class_name> has been
-loaded.
-
-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, but it can be fooled into reporting false
-positives. In particular, loading any of the core L<IO> modules will
-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 recognized is C<-version>, which will ensure
-that the loaded class has at least the required version.
-
 =item B<Class::MOP::get_code_info($code)>
 
 This function returns two values, the name of the package the C<$code>

diff --git a/lib/Class/MOP/Deprecated.pm b/lib/Class/MOP/Deprecated.pm
index a2a34e0..1ae1f61 100644 (file)
--- a/lib/Class/MOP/Deprecated.pm
+++ b/lib/Class/MOP/Deprecated.pm
@@ -4,6 +4,9 @@ use strict;
 use warnings;
 
 use Package::DeprecationManager -deprecations => {
+    'Class::MOP::load_class'                => '2.0200',
+    'Class::MOP::load_first_existing_class' => '2.0200',
+    'Class::MOP::is_class_loaded'           => '2.0200',
 };
 
 1;

diff --git a/lib/Class/MOP/Module.pm b/lib/Class/MOP/Module.pm
index 077cd38..5cc151a 100644 (file)
--- a/lib/Class/MOP/Module.pm
+++ b/lib/Class/MOP/Module.pm
@@ -74,7 +74,7 @@ sub _instantiate_module {
     my($self, $version, $authority) = @_;
     my $package_name = $self->name;
 
-    Class::MOP::_is_valid_class_name($package_name)
+    _is_valid_class_name($package_name)
         || confess "creation of $package_name failed: invalid package name";
 
     $self->add_package_symbol('$VERSION' => $version)
@@ -85,6 +85,18 @@ sub _instantiate_module {
     return;
 }
 
+sub _is_valid_class_name {
+    my $class = shift;
+
+    return 0 if ref($class);
+    return 0 unless defined($class);
+    return 0 unless length($class);
+
+    return 1 if $class =~ /^\w+(?:::\w+)*$/;
+
+    return 0;
+}
+
 1;
 
 # ABSTRACT: Module Meta Object

diff --git a/t/cmop/self_introspection.t b/t/cmop/self_introspection.t
index c735f74..dd16b19 100644 (file)
--- a/t/cmop/self_introspection.t
+++ b/t/cmop/self_introspection.t
@@ -44,6 +44,8 @@ my @class_mop_package_methods = qw(
 my @class_mop_module_methods = qw(
     _new
 
+    _is_valid_class_name
+
     _instantiate_module
 
     version authority identifier create

diff --git a/xs/MOP.xs b/xs/MOP.xs
index 398ea4e..0bf05dc 100644 (file)
--- a/xs/MOP.xs
+++ b/xs/MOP.xs
@@ -1,45 +1,5 @@
 #include "mop.h"
 
-static bool
-find_method (const char *key, STRLEN keylen, SV *val, void *ud)
-{
-    bool *found_method = (bool *)ud;
-    PERL_UNUSED_ARG(key);
-    PERL_UNUSED_ARG(keylen);
-    PERL_UNUSED_ARG(val);
-    *found_method = TRUE;
-    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;
-}
-
 MODULE = Class::MOP   PACKAGE = Class::MOP
 
 PROTOTYPES: DISABLE
@@ -59,53 +19,3 @@ get_code_info(coderef)
             mPUSHs(newSVpv(pkg, 0));
             mPUSHs(newSVpv(name, 0));
         }
-
-void
-is_class_loaded(klass, options=NULL)
-    SV *klass
-    HV *options
-    PREINIT:
-        HV *stash;
-        bool found_method = FALSE;
-    PPCODE:
-        SvGETMAGIC(klass);
-        if (!(SvPOKp(klass) && SvCUR(klass))) { /* XXX: SvPOK does not work with magical scalars */
-            XSRETURN_NO;
-        }
-
-        stash = gv_stashsv(klass, 0);
-        if (!stash) {
-            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;
-            if (version && HeVAL(version) && (version_sv = GvSV(HeVAL(version)))
-             && SvOK(version_sv)) {
-                XSRETURN_YES;
-            }
-        }
-
-        if (hv_exists_ent (stash, KEY_FOR(ISA), HASH_FOR(ISA))) {
-            HE *isa = hv_fetch_ent(stash, KEY_FOR(ISA), 0, HASH_FOR(ISA));
-            if (isa && HeVAL(isa) && GvAV(HeVAL(isa)) && av_len(GvAV(HeVAL(isa))) != -1) {
-                XSRETURN_YES;
-            }
-        }
-
-        mop_get_package_symbols(stash, TYPE_FILTER_CODE, find_method, &found_method);
-        if (found_method) {
-            XSRETURN_YES;
-        }
-
-        XSRETURN_NO;