1 package # hide from PAUSE
8 if ($INC{'DBIx/Class.pm'}) {
10 while (@frame = caller($fr++)) {
11 last if $frame[1] !~ m|^t/lib/DBICTest|;
14 die __PACKAGE__ . " must be loaded before DBIx::Class (or modules using DBIx::Class) at $frame[1] line $frame[2]\n";
17 if ( $ENV{DBICTEST_VERSION_WARNS_INDISCRIMINATELY} ) {
18 my $ov = UNIVERSAL->can("VERSION");
22 no warnings 'redefine';
23 *UNIVERSAL::VERSION = sub {
24 Carp::carp( 'Argument "blah bleh bloh" isn\'t numeric in subroutine entry' );
30 $ENV{DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION}
32 # keep it always on during CI
34 ($ENV{TRAVIS}||'') eq 'true'
36 ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
40 my $orig = \&Try::Tiny::try;
42 no warnings 'redefine';
43 *Try::Tiny::try = sub (&;@) {
44 my ($fr, $first_pkg) = 0;
45 while( $first_pkg = caller($fr++) ) {
46 last if $first_pkg !~ /^
53 if ($first_pkg =~ /DBIx::Class/) {
54 require Test::Builder;
55 Test::Builder->new->ok(0,
56 'Using try{} within DBIC internals is a mistake - use dbic_internal_try{} instead'
65 use Path::Class qw/file dir/;
69 use DBICTest::Util qw( local_umask find_co_root );
71 # Try to determine the root of a checkout/untar if possible
72 # return a Path::Class::Dir object or undef
73 sub _find_co_root { eval { dir( find_co_root() ) } }
75 _check_author_makefile() unless $ENV{DBICTEST_NO_MAKEFILE_VERIFICATION};
77 # PathTools has a bug where on MSWin32 it will often return / as a tmpdir.
78 # This is *really* stupid and the result of having our lockfiles all over
79 # the place is also rather obnoxious. So we use our own heuristics instead
80 # https://rt.cpan.org/Ticket/Display.html?id=76663
85 # works but not always
86 my $dir = dir(File::Spec->tmpdir);
87 my $reason_dir_unusable;
89 my @parts = File::Spec->splitdir($dir);
90 if (@parts == 2 and $parts[1] =~ /^ [\/\\]? $/x ) {
91 $reason_dir_unusable =
92 'File::Spec->tmpdir returned a root directory instead of a designated '
93 . 'tempdir (possibly https://rt.cpan.org/Ticket/Display.html?id=76663)';
96 # make sure we can actually create and sysopen a file in this dir
98 my $u = local_umask(0); # match the umask we use in DBICTest(::Schema)
99 my $tempfile = '<NONCREATABLE>';
101 $tempfile = File::Temp->new(
102 TEMPLATE => '_dbictest_writability_test_XXXXXX',
106 close $tempfile or die "closing $tempfile failed: $!\n";
108 sysopen (my $tempfh2, "$tempfile", O_RDWR) or die "reopening $tempfile failed: $!\n";
109 print $tempfh2 'deadbeef' x 1024 or die "printing to $tempfile failed: $!\n";
110 close $tempfh2 or die "closing $tempfile failed: $!\n";
113 chomp( my $err = $@ );
114 my @x_tests = map { (defined $_) ? ( $_ ? 1 : 0 ) : 'U' } map {(-e, -d, -f, -r, -w, -x, -o)} ("$dir", "$tempfile");
115 $reason_dir_unusable = sprintf <<"EOE", "$tempfile"||'', $err, scalar $>, scalar $), umask(), (stat($dir))[4,5,2], @x_tests;
116 File::Spec->tmpdir returned a directory which appears to be non-writeable:
117 Error encountered while testing '%s': %s
118 Process EUID/EGID: %s / %s
120 TmpDir UID/GID: %s / %s
122 TmpDir X-tests: -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
123 TmpFile X-tests: -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
128 if ($reason_dir_unusable) {
129 # Replace with our local project tmpdir. This will make multiple runs
130 # from different runs conflict with each other, but is much better than
131 # polluting the root dir with random crap or failing outright
132 my $local_dir = _find_co_root()->subdir('t')->subdir('var');
135 warn "\n\nUsing '$local_dir' as test scratch-dir instead of '$dir': $reason_dir_unusable\n";
144 # Die if the author did not update his makefile
146 # This is pretty heavy handed, so the check is pretty solid:
148 # 1) Assume that this particular module is loaded from -I <$root>/t/lib
149 # 2) Make sure <$root>/Makefile.PL exists
150 # 3) Make sure we can stat() <$root>/Makefile.PL
152 # If all of the above is satisfied
154 # *) die if <$root>/inc does not exist
155 # *) die if no stat() results for <$root>/Makefile (covers no Makefile)
156 # *) die if Makefile.PL mtime > Makefile mtime
158 sub _check_author_makefile {
160 my $root = _find_co_root()
163 my $optdeps = file('lib/DBIx/Class/Optional/Dependencies.pm');
165 # not using file->stat as it invokes File::stat which in turn breaks stat(_)
166 my ($mf_pl_mtime, $mf_mtime, $optdeps_mtime) = ( map
167 { (stat ($root->file ($_)) )[9] || undef } # stat returns () on nonexistent files
168 (qw|Makefile.PL Makefile|, $optdeps)
171 return unless $mf_pl_mtime; # something went wrong during co_root detection ?
175 if(not -d $root->subdir ('inc')) {
176 push @fail_reasons, "Missing ./inc directory";
180 push @fail_reasons, "Missing ./Makefile";
183 if($mf_mtime < $mf_pl_mtime) {
184 push @fail_reasons, "./Makefile.PL is newer than ./Makefile";
186 if($mf_mtime < $optdeps_mtime) {
187 push @fail_reasons, "./$optdeps is newer than ./Makefile";
192 print STDERR <<'EOE';
194 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
195 ======================== FATAL ERROR ===========================
196 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
198 We have a number of reasons to believe that this is a development
199 checkout and that you, the user, did not run `perl Makefile.PL`
200 before using this code. You absolutely _must_ perform this step,
201 to ensure you have all required dependencies present. Not doing
202 so often results in a lot of wasted time for other contributors
203 trying to assist you with spurious "its broken!" problems.
205 By default DBICs Makefile.PL turns all optional dependencies into
206 *HARD REQUIREMENTS*, in order to make sure that the entire test
207 suite is executed, and no tests are skipped due to missing modules.
208 If you for some reason need to disable this behavior - supply the
209 --skip_author_deps option when running perl Makefile.PL
211 If you are seeing this message unexpectedly (i.e. you are in fact
212 attempting a regular installation be it through CPAN or manually),
213 please report the situation to either the mailing list or to the
214 irc channel as described in
216 http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT
221 Reasons you received this message:
225 foreach my $r (@fail_reasons) {
226 print STDERR " * $r\n";
228 print STDERR "\n\n\n";
231 Time::HiRes::sleep(0.005);
232 print STDOUT "\nBail out!\n";
237 # Mimic $Module::Install::AUTHOR
240 my $root = _find_co_root()
244 ( not -d $root->subdir ('inc') )
246 ( -e $root->subdir ('inc')->subdir ($^O eq 'VMS' ? '_author' : '.author') )
252 ( $ENV{AUTOMATED_TESTING} && ! $ENV{PERL5_CPANM_IS_RUNNING} && ! $ENV{RELEASE_TESTING} )
260 ($ENV{TRAVIS}||'') eq 'true'
262 ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
268 ! $ENV{RELEASE_TESTING}
270 ! $ENV{DBICTEST_RUN_ALL_TESTS}
272 ! __PACKAGE__->is_smoker
274 ! __PACKAGE__->is_author