t/lib/DBICTest/RunMode.pm

   1 package # hide from PAUSE
   2     DBICTest::RunMode;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Path::Class qw/file dir/;
   8 use Fcntl ':DEFAULT';
   9 use File::Spec ();
  10 use File::Temp ();
  11 use DBICTest::Util qw( local_umask find_co_root );
  12
  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() ) } }
  16
  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
  21 my $tmpdir;
  22 sub tmpdir {
  23   dir ($tmpdir ||= do {
  24
  25     # works but not always
  26     my $dir = dir(File::Spec->tmpdir);
  27     my $reason_dir_unusable;
  28
  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)';
  34     }
  35     else {
  36       # make sure we can actually create and sysopen a file in this dir
  37       local $@;
  38       my $u = local_umask(0); # match the umask we use in DBICTest(::Schema)
  39       my $tempfile = '<NONCREATABLE>';
  40       eval {
  41         $tempfile = File::Temp->new(
  42           TEMPLATE => '_dbictest_writability_test_XXXXXX',
  43           DIR => "$dir",
  44           UNLINK => 1,
  45         );
  46         close $tempfile or die "closing $tempfile failed: $!\n";
  47
  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";
  51         1;
  52       } or do {
  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
  59 Effective umask:   %o
  60 TmpDir UID/GID:    %s / %s
  61 TmpDir StatMode:   %o
  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
  64 EOE
  65       };
  66     }
  67
  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');
  73       $local_dir->mkpath;
  74
  75       warn "\n\nUsing '$local_dir' as test scratch-dir instead of '$dir': $reason_dir_unusable\n";
  76       $dir = $local_dir;
  77     }
  78
  79     $dir->stringify;
  80   });
  81 }
  82
  83
  84 # Mimic $Module::Install::AUTHOR
  85 sub is_author {
  86
  87   return (
  88     ! -d 'inc/Module'
  89       or
  90     -e 'inc/.author'
  91   );
  92 }
  93
  94 sub is_smoker {
  95   return (
  96     ( $ENV{AUTOMATED_TESTING} && ! $ENV{PERL5_CPANM_IS_RUNNING} && ! $ENV{RELEASE_TESTING} )
  97       or
  98     __PACKAGE__->is_ci
  99   );
 100 }
 101
 102 sub is_ci {
 103   return (
 104     ($ENV{TRAVIS}||'') eq 'true'
 105       and
 106     ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
 107   )
 108 }
 109
 110 sub is_plain {
 111   return (
 112     ! $ENV{RELEASE_TESTING}
 113       and
 114     ! $ENV{DBICTEST_RUN_ALL_TESTS}
 115       and
 116     ! __PACKAGE__->is_smoker
 117       and
 118     ! __PACKAGE__->is_author
 119   )
 120 }
 121
 122 1;