From: Peter Rabbitson <ribasushi@cpan.org>
Date: Mon, 11 Apr 2016 09:49:56 +0000 (+0200)
Subject: Lose another dependency: Class::Inspector
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=817ac9e927cd8e29d1bf553714379e54df5dbef7;p=dbsrgits%2FDBIx-Class.git

Lose another dependency: Class::Inspector

It is either used in tests (where we cargocult a similar function), or in a
spot where Package::Stash will do
---

diff --git a/Makefile.PL b/Makefile.PL
index a44941b..ccd2769 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -55,7 +55,6 @@ my $runtime_requires = {
   # pure-perl (FatPack-able) libs
   'Class::Accessor::Grouped' => '0.10012',
   'Class::C3::Componentised' => '1.0009',
-  'Class::Inspector'         => '1.24',
   'Context::Preserve'        => '0.01',
   'Data::Page'               => '2.00',
   'Devel::GlobalDestruction' => '0.09',
diff --git a/lib/DBIx/Class/ResultSetManager.pm b/lib/DBIx/Class/ResultSetManager.pm
index bb9f3bf..0022e8a 100644
--- a/lib/DBIx/Class/ResultSetManager.pm
+++ b/lib/DBIx/Class/ResultSetManager.pm
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use base 'DBIx::Class';
 use Sub::Name ();
-use Class::Inspector;
+use Package::Stash ();
 
 warn "DBIx::Class::ResultSetManager never left experimental status and
 has now been DEPRECATED. This module will be deleted in 09000 so please
@@ -53,7 +53,16 @@ sub _register_attributes {
     my $cache = $self->_attr_cache;
     return if keys %$cache == 0;
 
-    foreach my $meth (@{Class::Inspector->methods($self) || []}) {
+    foreach my $meth (keys %{ { map
+      { $_ => 1 }
+      map
+        { Package::Stash->new($_)->list_all_symbols("CODE") }
+        @{ mro::get_linear_isa( ref $self || $self ) }
+    } } ) {
+        # *DO NOT* rely on P::S returning crefs in reverse mro order
+        # but instead ask the mro to redo the lookup
+        # This codepath is extremely old, miht as well keep it running
+        # as-is with no room for surprises
         my $attrs = $cache->{$self->can($meth)};
         next unless $attrs;
         if ($attrs->[0] eq 'ResultSet') {
diff --git a/t/cdbi/has_many_loads_foreign_class.t b/t/cdbi/has_many_loads_foreign_class.t
index a0af15a..be5553d 100644
--- a/t/cdbi/has_many_loads_foreign_class.t
+++ b/t/cdbi/has_many_loads_foreign_class.t
@@ -7,11 +7,11 @@ use warnings;
 use Test::More;
 
 use lib 't/cdbi/testlib';
+use DBICTest::Util 'class_seems_loaded';
 use Director;
 
 # Test that has_many() will load the foreign class
-require Class::Inspector;
-ok !Class::Inspector->loaded( 'Film' );
+ok ! class_seems_loaded('Film'), 'Start non-loaded';
 ok eval { Director->has_many( films => 'Film' ); 1; } or diag $@;
 
 my $shan_hua = Director->create({
diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm
index b084560..3bcbe89 100644
--- a/t/lib/DBICTest/Util.pm
+++ b/t/lib/DBICTest/Util.pm
@@ -35,7 +35,7 @@ use DBIx::Class::_Util qw( scope_guard parent_dir mkdir_p );
 
 use base 'Exporter';
 our @EXPORT_OK = qw(
-  dbg stacktrace
+  dbg stacktrace class_seems_loaded
   local_umask slurp_bytes tmpdir find_co_root rm_rf
   visit_namespaces PEEPEENESS
   check_customcond_args
@@ -431,4 +431,27 @@ sub visit_namespaces {
   return $visited_count;
 }
 
+#
+# Replicate the *heuristic* (important!!!) implementation found in various
+# forms within Class::Load / Module::Inspector / Class::C3::Componentised
+#
+sub class_seems_loaded ($) {
+
+  croak "Function expects a class name as plain string (no references)"
+    unless defined $_[0] and not length ref $_[0];
+
+  no strict 'refs';
+
+  return 1 if defined ${"$_[0]::VERSION"};
+
+  return 1 if @{"$_[0]::ISA"};
+
+  return 1 if $INC{ (join ('/', split ('::', $_[0]) ) ) . '.pm' };
+
+  ( !!*{"$_[0]::$_"}{CODE} ) and return 1
+    for keys %{"$_[0]::"};
+
+  return 0;
+}
+
 1;
diff --git a/t/resultset_class.t b/t/resultset_class.t
index 43054a5..3d79022 100644
--- a/t/resultset_class.t
+++ b/t/resultset_class.t
@@ -3,18 +3,18 @@ BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
 use strict;
 use warnings;
 use Test::More;
-use Class::Inspector ();
 
 use DBICTest;
+use DBICTest::Util 'class_seems_loaded';
 
 is(DBICTest::Schema->source('Artist')->resultset_class, 'DBICTest::BaseResultSet', 'default resultset class');
-ok(!Class::Inspector->loaded('DBICNSTest::ResultSet::A'), 'custom resultset class not loaded');
+ok(! class_seems_loaded('DBICNSTest::ResultSet::A'), 'custom resultset class not loaded');
 
 DBICTest::Schema->source('Artist')->resultset_class('DBICNSTest::ResultSet::A');
 
-ok(!Class::Inspector->loaded('DBICNSTest::ResultSet::A'), 'custom resultset class not loaded on SET');
+ok(! class_seems_loaded('DBICNSTest::ResultSet::A'), 'custom resultset class not loaded on SET');
 is(DBICTest::Schema->source('Artist')->resultset_class, 'DBICNSTest::ResultSet::A', 'custom resultset class set');
-ok(Class::Inspector->loaded('DBICNSTest::ResultSet::A'), 'custom resultset class loaded on GET');
+ok(class_seems_loaded('DBICNSTest::ResultSet::A'), 'custom resultset class loaded on GET');
 
 my $schema = DBICTest->init_schema;
 my $resultset = $schema->resultset('Artist')->search;
diff --git a/xt/extra/internals/ensure_class_loaded.t b/xt/extra/internals/ensure_class_loaded.t
index 3dba83d..d106d3e 100644
--- a/xt/extra/internals/ensure_class_loaded.t
+++ b/xt/extra/internals/ensure_class_loaded.t
@@ -7,7 +7,7 @@ use Test::More;
 
 use DBICTest;
 use DBIx::Class::_Util 'sigwarn_silencer';
-use Class::Inspector;
+use DBICTest::Util 'class_seems_loaded';
 
 BEGIN {
   package TestPackage::A;
@@ -21,11 +21,11 @@ plan tests => 28;
 # Test ensure_class_found
 ok( $schema->ensure_class_found('DBIx::Class::Schema'),
     'loaded package DBIx::Class::Schema was found' );
-ok( !Class::Inspector->loaded('DBICTest::FakeComponent'),
+ok( ! class_seems_loaded('DBICTest::FakeComponent'),
     'DBICTest::FakeComponent not loaded yet' );
 ok( $schema->ensure_class_found('DBICTest::FakeComponent'),
     'package DBICTest::FakeComponent was found' );
-ok( !Class::Inspector->loaded('DBICTest::FakeComponent'),
+ok( ! class_seems_loaded('DBICTest::FakeComponent'),
     'DBICTest::FakeComponent not loaded by ensure_class_found()' );
 ok( $schema->ensure_class_found('TestPackage::A'),
     'anonymous package TestPackage::A found' );
@@ -88,17 +88,17 @@ like( $@, qr/did not return a true value/,
 }
 
 # Test ensure_class_loaded
-ok( Class::Inspector->loaded('TestPackage::A'), 'anonymous package exists' );
+ok( class_seems_loaded('TestPackage::A'), 'anonymous package exists' );
 eval { $schema->ensure_class_loaded('TestPackage::A'); };
 ok( !$@, 'ensure_class_loaded detected an anon. class' );
 eval { $schema->ensure_class_loaded('FakePackage::B'); };
 like( $@, qr/Can't locate/,
      'ensure_class_loaded threw exception for nonexistent class' );
-ok( !Class::Inspector->loaded('DBICTest::FakeComponent'),
+ok( ! class_seems_loaded('DBICTest::FakeComponent'),
    'DBICTest::FakeComponent not loaded yet' );
 eval { $schema->ensure_class_loaded('DBICTest::FakeComponent'); };
 ok( !$@, 'ensure_class_loaded detected an existing but non-loaded class' );
-ok( Class::Inspector->loaded('DBICTest::FakeComponent'),
+ok( class_seems_loaded('DBICTest::FakeComponent'),
    'DBICTest::FakeComponent now loaded' );
 
 {
diff --git a/xt/extra/internals/namespaces_cleaned.t b/xt/extra/internals/namespaces_cleaned.t
index b8b42b7..3f70262 100644
--- a/xt/extra/internals/namespaces_cleaned.t
+++ b/xt/extra/internals/namespaces_cleaned.t
@@ -90,10 +90,6 @@ my $has_moose = eval { require Moose::Util };
 
 Sub::Defer::undefer_all();
 
-# can't use Class::Inspector for the mundane parts as it does not
-# distinguish imports from anything else, what a crock of...
-# Moose is not always available either - hence just do it ourselves
-
 my $seen; #inheritance means we will see the same method multiple times
 
 for my $mod (@modules) {