X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest%2FUtil.pm;h=dc34406005f451c175aa2ea673948dd80cb1e593;hb=3605497bcb83ef83a4859a84e52c03f77f3cd626;hp=b084560f30cc64b92e8025361cefdd09d00a2fca;hpb=820a29360e4920d9edff9e9cefe721b8a265e40d;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm
index b084560..dc34406 100644
--- a/t/lib/DBICTest/Util.pm
+++ b/t/lib/DBICTest/Util.pm
@@ -5,7 +5,11 @@ use strict;
 
 use ANFANG;
 
-use DBICTest::RunMode;
+use Config;
+use Carp qw(cluck confess croak);
+use Fcntl qw( :DEFAULT :flock );
+use Scalar::Util qw( blessed refaddr openhandle );
+use DBIx::Class::_Util qw( scope_guard parent_dir );
 
 use constant {
 
@@ -19,25 +23,25 @@ use constant {
   # add an escape for these perls ON SMOKERS - a user/CI will still get death
   # constname a homage to http://theoatmeal.com/comics/working_home
   PEEPEENESS => (
+    (
+      DBIx::Class::_ENV_::PERL_VERSION >= 5.013005
+        and
+      DBIx::Class::_ENV_::PERL_VERSION <= 5.013006
+    )
+      and
+    require DBICTest::RunMode
+      and
     DBICTest::RunMode->is_smoker
       and
     ! DBICTest::RunMode->is_ci
-      and
-    ( "$]" >= 5.013005 and "$]" <= 5.013006)
   ),
 };
 
-use Config;
-use Carp qw(cluck confess croak);
-use Fcntl qw( :DEFAULT :flock );
-use Scalar::Util qw( blessed refaddr openhandle );
-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
+  PEEPEENESS
   check_customcond_args
   await_flock DEBUG_TEST_CONCURRENCY_LOCKS
 );
@@ -249,7 +253,15 @@ EOE
       # polluting the root dir with random crap or failing outright
       my $local_dir = find_co_root . 't/var/';
 
-      mkdir_p $local_dir;
+      # Generlly this should be handled by ANFANG, but double-check ourselves
+      # Not using mkdir_p here: we *know* everything else up until 'var' exists
+      # If it doesn't - we better fail outright
+      # (also saves an extra File::Path require(), small enough as it is)
+      -d $local_dir
+        or
+      mkdir $local_dir
+        or
+      die "Unable to create build-local tempdir '$local_dir': $!\n";
 
       warn "\n\nUsing '$local_dir' as test scratch-dir instead of '$dir': $reason_dir_unusable\n\n";
       $dir = $local_dir;
@@ -401,34 +413,27 @@ sub check_customcond_args ($) {
   $args;
 }
 
-sub visit_namespaces {
-  my $args = { (ref $_[0]) ? %{$_[0]} : @_ };
-
-  my $visited_count = 1;
-
-  # A package and a namespace are subtly different things
-  $args->{package} ||= 'main';
-  $args->{package} = 'main' if $args->{package} =~ /^ :: (?: main )? $/x;
-  $args->{package} =~ s/^:://;
-
-  if ( $args->{action}->($args->{package}) ) {
-    my $ns =
-      ( ($args->{package} eq 'main') ? '' :  $args->{package} )
-        .
-      '::'
-    ;
-
-    $visited_count += visit_namespaces( %$args, package => $_ ) for
-      grep
-        # this happens sometimes on %:: traversal
-        { $_ ne '::main' }
-        map
-          { $_ =~ /^(.+?)::$/ ? "$ns$1" : () }
-          do { no strict 'refs'; keys %$ns }
-    ;
-  }
+#
+# 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 $visited_count;
+  return 0;
 }
 
 1;