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 _check_author_makefile() unless $ENV{DBICTEST_NO_MAKEFILE_VERIFICATION};
19 # PathTools has a bug where on MSWin32 it will often return / as a tmpdir.
20 # This is *really* stupid and the result of having our lockfiles all over
21 # the place is also rather obnoxious. So we use our own heuristics instead
22 # https://rt.cpan.org/Ticket/Display.html?id=76663
27 # works but not always
28 my $dir = dir(File::Spec->tmpdir);
29 my $reason_dir_unusable;
31 my @parts = File::Spec->splitdir($dir);
32 if (@parts == 2 and $parts[1] =~ /^ [\/\\]? $/x ) {
33 $reason_dir_unusable =
34 'File::Spec->tmpdir returned a root directory instead of a designated '
35 . 'tempdir (possibly https://rt.cpan.org/Ticket/Display.html?id=76663)';
38 # make sure we can actually create and sysopen a file in this dir
40 my $u = local_umask(0); # match the umask we use in DBICTest(::Schema)
41 my $tempfile = '<NONCREATABLE>';
43 $tempfile = File::Temp->new(
44 TEMPLATE => '_dbictest_writability_test_XXXXXX',
48 close $tempfile or die "closing $tempfile failed: $!\n";
50 sysopen (my $tempfh2, "$tempfile", O_RDWR) or die "reopening $tempfile failed: $!\n";
51 print $tempfh2 'deadbeef' x 1024 or die "printing to $tempfile failed: $!\n";
52 close $tempfh2 or die "closing $tempfile failed: $!\n";
55 chomp( my $err = $@ );
56 my @x_tests = map { (defined $_) ? ( $_ ? 1 : 0 ) : 'U' } map {(-e, -d, -f, -r, -w, -x, -o)} ("$dir", "$tempfile");
57 $reason_dir_unusable = sprintf <<"EOE", "$tempfile"||'', $err, scalar $>, scalar $), umask(), (stat($dir))[4,5,2], @x_tests;
58 File::Spec->tmpdir returned a directory which appears to be non-writeable:
59 Error encountered while testing '%s': %s
60 Process EUID/EGID: %s / %s
62 TmpDir UID/GID: %s / %s
64 TmpDir X-tests: -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
65 TmpFile X-tests: -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
70 if ($reason_dir_unusable) {
71 # Replace with our local project tmpdir. This will make multiple runs
72 # from different runs conflict with each other, but is much better than
73 # polluting the root dir with random crap or failing outright
74 my $local_dir = _find_co_root()->subdir('t')->subdir('var');
77 warn "\n\nUsing '$local_dir' as test scratch-dir instead of '$dir': $reason_dir_unusable\n";
86 # Die if the author did not update his makefile
88 # This is pretty heavy handed, so the check is pretty solid:
90 # 1) Assume that this particular module is loaded from -I <$root>/t/lib
91 # 2) Make sure <$root>/Makefile.PL exists
92 # 3) Make sure we can stat() <$root>/Makefile.PL
94 # If all of the above is satisfied
96 # *) die if <$root>/inc does not exist
97 # *) die if no stat() results for <$root>/Makefile (covers no Makefile)
98 # *) die if Makefile.PL mtime > Makefile mtime
100 sub _check_author_makefile {
102 my $root = _find_co_root()
105 my $optdeps = file('lib/DBIx/Class/Optional/Dependencies.pm');
107 # not using file->stat as it invokes File::stat which in turn breaks stat(_)
108 my ($mf_pl_mtime, $mf_mtime, $optdeps_mtime) = ( map
109 { (stat ($root->file ($_)) )[9] || undef } # stat returns () on nonexistent files
110 (qw|Makefile.PL Makefile|, $optdeps)
113 return unless $mf_pl_mtime; # something went wrong during co_root detection ?
117 if(not -d $root->subdir ('inc')) {
118 push @fail_reasons, "Missing ./inc directory";
122 push @fail_reasons, "Missing ./Makefile";
125 if($mf_mtime < $mf_pl_mtime) {
126 push @fail_reasons, "./Makefile.PL is newer than ./Makefile";
128 if($mf_mtime < $optdeps_mtime) {
129 push @fail_reasons, "./$optdeps is newer than ./Makefile";
134 print STDERR <<'EOE';
136 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
137 ======================== FATAL ERROR ===========================
138 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
140 We have a number of reasons to believe that this is a development
141 checkout and that you, the user, did not run `perl Makefile.PL`
142 before using this code. You absolutely _must_ perform this step,
143 to ensure you have all required dependencies present. Not doing
144 so often results in a lot of wasted time for other contributors
145 trying to assist you with spurious "its broken!" problems.
147 By default DBICs Makefile.PL turns all optional dependencies into
148 *HARD REQUIREMENTS*, in order to make sure that the entire test
149 suite is executed, and no tests are skipped due to missing modules.
150 If you for some reason need to disable this behavior - supply the
151 --skip_author_deps option when running perl Makefile.PL
153 If you are seeing this message unexpectedly (i.e. you are in fact
154 attempting a regular installation be it through CPAN or manually),
155 please report the situation to either the mailing list or to the
156 irc channel as described in
158 http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT
163 Reasons you received this message:
167 foreach my $r (@fail_reasons) {
168 print STDERR " * $r\n";
170 print STDERR "\n\n\n";
173 Time::HiRes::sleep(0.005);
174 print STDOUT "\nBail out!\n";
179 # Mimic $Module::Install::AUTHOR
182 my $root = _find_co_root()
186 ( not -d $root->subdir ('inc') )
188 ( -e $root->subdir ('inc')->subdir ($^O eq 'VMS' ? '_author' : '.author') )
194 ( $ENV{AUTOMATED_TESTING} && ! $ENV{PERL5_CPANM_IS_RUNNING} && ! $ENV{RELEASE_TESTING} )
202 ($ENV{TRAVIS}||'') eq 'true'
204 ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
210 ! $ENV{RELEASE_TESTING}
212 ! $ENV{DBICTEST_RUN_ALL_TESTS}
214 ! __PACKAGE__->is_smoker
216 ! __PACKAGE__->is_author