From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 18 Apr 2012 16:16:22 +0000 (+0200)
Subject: Better handling of bogus tmpdir returned by File::Spec on MSWin32
X-Git-Tag: v0.08197~27
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9b871b00c;p=dbsrgits%2FDBIx-Class.git

Better handling of bogus tmpdir returned by File::Spec on MSWin32
---

diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index 8b36d10..ff8db7f 100644
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -60,7 +60,7 @@ our ($global_lock_fh, $global_exclusive_lock);
 sub import {
     my $self = shift;
 
-    my $lockpath = File::Spec->catfile(File::Spec->tmpdir, '.dbictest_global.lock');
+    my $lockpath = DBICTest::RunMode->tmpdir->file('.dbictest_global.lock');
 
     {
       my $u = local_umask(0); # so that the file opens as 666, and any user can lock
diff --git a/t/lib/DBICTest/RunMode.pm b/t/lib/DBICTest/RunMode.pm
index b773c5d..7611e4c 100644
--- a/t/lib/DBICTest/RunMode.pm
+++ b/t/lib/DBICTest/RunMode.pm
@@ -16,9 +16,35 @@ BEGIN {
 }
 
 use Path::Class qw/file dir/;
+use File::Spec;
 
 _check_author_makefile() unless $ENV{DBICTEST_NO_MAKEFILE_VERIFICATION};
 
+# PathTools has a bug where on MSWin32 it will often return / as a tmpdir.
+# This is *really* stupid and the result of having our lockfiles all over
+# the place is also rather obnoxious. So we use our own heuristics instead
+# https://rt.cpan.org/Ticket/Display.html?id=76663
+my $tmpdir;
+sub tmpdir {
+  $tmpdir ||= do {
+
+    my $dir = dir(File::Spec->tmpdir);
+
+    my @parts = File::Spec->splitdir($dir);
+    if (@parts == 2 and $parts[1] eq '') {
+      # This means we were give the root dir (C:\ or something equally unacceptable)
+      # Replace with our local project tmpdir. This will make multiple runs
+      # from different runs conflict with each other, but is much better than
+      # polluting the root dir with random crap
+      $dir = _find_co_root()->subdir('t')->subdir('var');
+      $dir->mkpath;
+    }
+
+    $dir;
+  };
+}
+
+
 # Die if the author did not update his makefile
 #
 # This is pretty heavy handed, so the check is pretty solid:
diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm
index d24acbd..a4a6d5e 100644
--- a/t/lib/DBICTest/Schema.pm
+++ b/t/lib/DBICTest/Schema.pm
@@ -9,8 +9,7 @@ use base 'DBIx::Class::Schema';
 
 use Fcntl qw/:DEFAULT :seek :flock/;
 use Time::HiRes 'sleep';
-use Path::Class::File;
-use File::Spec;
+use DBICTest::RunMode;
 use DBICTest::Util qw/populate_weakregistry assert_empty_weakregistry local_umask/;
 use namespace::clean;
 
@@ -150,9 +149,13 @@ sub connection {
     # Also if there is no connection - there is no lock to be had
     if ($locktype and (!$locker or $locker->{type} ne $locktype)) {
 
-      warn "$$ $0 $locktype" if $locktype eq 'generic' or $locktype eq 'SQLite';
+      warn "$$ $0 $locktype" if (
+        ($locktype eq 'generic' or $locktype eq 'SQLite')
+          and
+        DBICTest::RunMode->is_author
+      );
 
-      my $lockpath = File::Spec->tmpdir . "/.dbictest_$locktype.lock";
+      my $lockpath = DBICTest::RunMode->tmpdir->file(".dbictest_$locktype.lock");
 
       my $lock_fh;
       {