1 package # hide from PAUSE
7 use Path::Class qw/file dir/;
11 use DBICTest::Util qw( local_umask find_co_root );
13 # Try to determine the root of a checkout/untar if possible
14 # return a Path::Class::Dir object or undef
15 sub _find_co_root { eval { dir( find_co_root() ) } }
17 # PathTools has a bug where on MSWin32 it will often return / as a tmpdir.
18 # This is *really* stupid and the result of having our lockfiles all over
19 # the place is also rather obnoxious. So we use our own heuristics instead
20 # https://rt.cpan.org/Ticket/Display.html?id=76663
25 # works but not always
26 my $dir = dir(File::Spec->tmpdir);
27 my $reason_dir_unusable;
29 my @parts = File::Spec->splitdir($dir);
30 if (@parts == 2 and $parts[1] =~ /^ [\/\\]? $/x ) {
31 $reason_dir_unusable =
32 'File::Spec->tmpdir returned a root directory instead of a designated '
33 . 'tempdir (possibly https://rt.cpan.org/Ticket/Display.html?id=76663)';
36 # make sure we can actually create and sysopen a file in this dir
38 my $u = local_umask(0); # match the umask we use in DBICTest(::Schema)
39 my $tempfile = '<NONCREATABLE>';
41 $tempfile = File::Temp->new(
42 TEMPLATE => '_dbictest_writability_test_XXXXXX',
46 close $tempfile or die "closing $tempfile failed: $!\n";
48 sysopen (my $tempfh2, "$tempfile", O_RDWR) or die "reopening $tempfile failed: $!\n";
49 print $tempfh2 'deadbeef' x 1024 or die "printing to $tempfile failed: $!\n";
50 close $tempfh2 or die "closing $tempfile failed: $!\n";
53 chomp( my $err = $@ );
54 my @x_tests = map { (defined $_) ? ( $_ ? 1 : 0 ) : 'U' } map {(-e, -d, -f, -r, -w, -x, -o)} ("$dir", "$tempfile");
55 $reason_dir_unusable = sprintf <<"EOE", "$tempfile"||'', $err, scalar $>, scalar $), umask(), (stat($dir))[4,5,2], @x_tests;
56 File::Spec->tmpdir returned a directory which appears to be non-writeable:
57 Error encountered while testing '%s': %s
58 Process EUID/EGID: %s / %s
60 TmpDir UID/GID: %s / %s
62 TmpDir X-tests: -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
63 TmpFile X-tests: -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
68 if ($reason_dir_unusable) {
69 # Replace with our local project tmpdir. This will make multiple runs
70 # from different runs conflict with each other, but is much better than
71 # polluting the root dir with random crap or failing outright
72 my $local_dir = _find_co_root()->subdir('t')->subdir('var');
75 warn "\n\nUsing '$local_dir' as test scratch-dir instead of '$dir': $reason_dir_unusable\n";
84 # Mimic $Module::Install::AUTHOR
96 ( $ENV{AUTOMATED_TESTING} && ! $ENV{PERL5_CPANM_IS_RUNNING} && ! $ENV{RELEASE_TESTING} )
104 ($ENV{TRAVIS}||'') eq 'true'
106 ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
112 ! $ENV{RELEASE_TESTING}
114 ! $ENV{DBICTEST_RUN_ALL_TESTS}
116 ! __PACKAGE__->is_smoker
118 ! __PACKAGE__->is_author