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 'local_umask';
71 _check_author_makefile() unless $ENV{DBICTEST_NO_MAKEFILE_VERIFICATION};
73 # PathTools has a bug where on MSWin32 it will often return / as a tmpdir.
74 # This is *really* stupid and the result of having our lockfiles all over
75 # the place is also rather obnoxious. So we use our own heuristics instead
76 # https://rt.cpan.org/Ticket/Display.html?id=76663
81 # works but not always
82 my $dir = dir(File::Spec->tmpdir);
83 my $reason_dir_unusable;
85 my @parts = File::Spec->splitdir($dir);
86 if (@parts == 2 and $parts[1] =~ /^ [ \\ \/ ]? $/x ) {
87 $reason_dir_unusable =
88 'File::Spec->tmpdir returned a root directory instead of a designated '
89 . 'tempdir (possibly https://rt.cpan.org/Ticket/Display.html?id=76663)';
92 # make sure we can actually create and sysopen a file in this dir
94 my $u = local_umask(0); # match the umask we use in DBICTest(::Schema)
95 my $tempfile = '<NONCREATABLE>';
97 $tempfile = File::Temp->new(
98 TEMPLATE => '_dbictest_writability_test_XXXXXX',
102 close $tempfile or die "closing $tempfile failed: $!\n";
104 sysopen (my $tempfh2, "$tempfile", O_RDWR) or die "reopening $tempfile failed: $!\n";
105 print $tempfh2 'deadbeef' x 1024 or die "printing to $tempfile failed: $!\n";
106 close $tempfh2 or die "closing $tempfile failed: $!\n";
109 chomp( my $err = $@ );
110 my @x_tests = map { (defined $_) ? ( $_ ? 1 : 0 ) : 'U' } map {(-e, -d, -f, -r, -w, -x, -o)} ("$dir", "$tempfile");
111 $reason_dir_unusable = sprintf <<"EOE", "$tempfile"||'', $err, scalar $>, scalar $), umask(), (stat($dir))[4,5,2], @x_tests;
112 File::Spec->tmpdir returned a directory which appears to be non-writeable:
113 Error encountered while testing '%s': %s
114 Process EUID/EGID: %s / %s
116 TmpDir UID/GID: %s / %s
118 TmpDir X-tests: -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
119 TmpFile X-tests: -e:%s -d:%s -f:%s -r:%s -w:%s -x:%s -o:%s
124 if ($reason_dir_unusable) {
125 # Replace with our local project tmpdir. This will make multiple runs
126 # from different runs conflict with each other, but is much better than
127 # polluting the root dir with random crap or failing outright
128 my $local_dir = _find_co_root()->subdir('t')->subdir('var');
131 warn "\n\nUsing '$local_dir' as test scratch-dir instead of '$dir': $reason_dir_unusable\n";
140 # Die if the author did not update his makefile
142 # This is pretty heavy handed, so the check is pretty solid:
144 # 1) Assume that this particular module is loaded from -I <$root>/t/lib
145 # 2) Make sure <$root>/Makefile.PL exists
146 # 3) Make sure we can stat() <$root>/Makefile.PL
148 # If all of the above is satisfied
150 # *) die if <$root>/inc does not exist
151 # *) die if no stat() results for <$root>/Makefile (covers no Makefile)
152 # *) die if Makefile.PL mtime > Makefile mtime
154 sub _check_author_makefile {
156 my $root = _find_co_root()
159 my $optdeps = file('lib/DBIx/Class/Optional/Dependencies.pm');
161 # not using file->stat as it invokes File::stat which in turn breaks stat(_)
162 my ($mf_pl_mtime, $mf_mtime, $optdeps_mtime) = ( map
163 { (stat ($root->file ($_)) )[9] || undef } # stat returns () on nonexistent files
164 (qw|Makefile.PL Makefile|, $optdeps)
167 return unless $mf_pl_mtime; # something went wrong during co_root detection ?
171 if(not -d $root->subdir ('inc')) {
172 push @fail_reasons, "Missing ./inc directory";
176 push @fail_reasons, "Missing ./Makefile";
179 if($mf_mtime < $mf_pl_mtime) {
180 push @fail_reasons, "./Makefile.PL is newer than ./Makefile";
182 if($mf_mtime < $optdeps_mtime) {
183 push @fail_reasons, "./$optdeps is newer than ./Makefile";
188 print STDERR <<'EOE';
190 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
191 ======================== FATAL ERROR ===========================
192 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
194 We have a number of reasons to believe that this is a development
195 checkout and that you, the user, did not run `perl Makefile.PL`
196 before using this code. You absolutely _must_ perform this step,
197 to ensure you have all required dependencies present. Not doing
198 so often results in a lot of wasted time for other contributors
199 trying to assist you with spurious "its broken!" problems.
201 By default DBICs Makefile.PL turns all optional dependencies into
202 *HARD REQUIREMENTS*, in order to make sure that the entire test
203 suite is executed, and no tests are skipped due to missing modules.
204 If you for some reason need to disable this behavior - supply the
205 --skip_author_deps option when running perl Makefile.PL
207 If you are seeing this message unexpectedly (i.e. you are in fact
208 attempting a regular installation be it through CPAN or manually),
209 please report the situation to either the mailing list or to the
210 irc channel as described in
212 http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT
217 Reasons you received this message:
221 foreach my $r (@fail_reasons) {
222 print STDERR " * $r\n";
224 print STDERR "\n\n\n";
227 Time::HiRes::sleep(0.005);
228 print STDOUT "\nBail out!\n";
233 # Mimic $Module::Install::AUTHOR
236 my $root = _find_co_root()
240 ( not -d $root->subdir ('inc') )
242 ( -e $root->subdir ('inc')->subdir ($^O eq 'VMS' ? '_author' : '.author') )
248 ( $ENV{AUTOMATED_TESTING} && ! $ENV{PERL5_CPANM_IS_RUNNING} && ! $ENV{RELEASE_TESTING} )
256 ($ENV{TRAVIS}||'') eq 'true'
258 ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
264 ! $ENV{RELEASE_TESTING}
266 ! $ENV{DBICTEST_RUN_ALL_TESTS}
268 ! __PACKAGE__->is_smoker
270 ! __PACKAGE__->is_author
274 # Try to determine the root of a checkout/untar if possible
278 my @mod_parts = split /::/, (__PACKAGE__ . '.pm');
279 my $rel_path = join ('/', @mod_parts); # %INC stores paths with / regardless of OS
281 return undef unless ($INC{$rel_path});
283 # a bit convoluted, but what we do here essentially is:
284 # - get the file name of this particular module
285 # - do 'cd ..' as many times as necessary to get to t/lib/../..
287 my $root = dir ($INC{$rel_path});
288 for (1 .. @mod_parts + 2) {
289 $root = $root->parent;
292 return (-f $root->file ('Makefile.PL') )