fix typo in FATAL ERROR message.
[dbsrgits/DBIx-Class.git] / t / lib / DBICTest / RunMode.pm
CommitLineData
4bea1fe7 1package # hide from PAUSE
39c9c72d 2 DBICTest::RunMode;
ab340f7f 3
4use strict;
5use warnings;
6
4bea1fe7 7BEGIN {
8 if ($INC{'DBIx/Class.pm'}) {
9 my ($fr, @frame) = 1;
10 while (@frame = caller($fr++)) {
11 last if $frame[1] !~ m|^t/lib/DBICTest|;
12 }
13
14 die __PACKAGE__ . " must be loaded before DBIx::Class (or modules using DBIx::Class) at $frame[1] line $frame[2]\n";
15 }
16}
17
ab340f7f 18use Path::Class qw/file dir/;
9b871b00 19use File::Spec;
ab340f7f 20
21_check_author_makefile() unless $ENV{DBICTEST_NO_MAKEFILE_VERIFICATION};
22
9b871b00 23# PathTools has a bug where on MSWin32 it will often return / as a tmpdir.
24# This is *really* stupid and the result of having our lockfiles all over
25# the place is also rather obnoxious. So we use our own heuristics instead
26# https://rt.cpan.org/Ticket/Display.html?id=76663
27my $tmpdir;
28sub tmpdir {
85143769 29 dir ($tmpdir ||= do {
9b871b00 30
31 my $dir = dir(File::Spec->tmpdir);
32
33 my @parts = File::Spec->splitdir($dir);
34 if (@parts == 2 and $parts[1] eq '') {
35 # This means we were give the root dir (C:\ or something equally unacceptable)
36 # Replace with our local project tmpdir. This will make multiple runs
37 # from different runs conflict with each other, but is much better than
38 # polluting the root dir with random crap
39 $dir = _find_co_root()->subdir('t')->subdir('var');
40 $dir->mkpath;
41 }
42
85143769 43 $dir->stringify;
44 });
9b871b00 45}
46
47
ab340f7f 48# Die if the author did not update his makefile
49#
50# This is pretty heavy handed, so the check is pretty solid:
51#
52# 1) Assume that this particular module is loaded from -I <$root>/t/lib
53# 2) Make sure <$root>/Makefile.PL exists
54# 3) Make sure we can stat() <$root>/Makefile.PL
55#
56# If all of the above is satisfied
57#
58# *) die if <$root>/inc does not exist
59# *) die if no stat() results for <$root>/Makefile (covers no Makefile)
60# *) die if Makefile.PL mtime > Makefile mtime
61#
62sub _check_author_makefile {
63
64 my $root = _find_co_root()
65 or return;
66
7159a456 67 my $optdeps = file('lib/DBIx/Class/Optional/Dependencies.pm');
68
ab340f7f 69 # not using file->stat as it invokes File::stat which in turn breaks stat(_)
7159a456 70 my ($mf_pl_mtime, $mf_mtime, $optdeps_mtime) = ( map
50360f3e 71 { (stat ($root->file ($_)) )[9] || undef } # stat returns () on nonexistent files
7159a456 72 (qw|Makefile.PL Makefile|, $optdeps)
ab340f7f 73 );
74
75 return unless $mf_pl_mtime; # something went wrong during co_root detection ?
76
7159a456 77 my @fail_reasons;
ab340f7f 78
7159a456 79 if(not -d $root->subdir ('inc')) {
80 push @fail_reasons, "Missing ./inc directory";
81 }
ab340f7f 82
a256e995 83 if(not $mf_mtime) {
7159a456 84 push @fail_reasons, "Missing ./Makefile";
85 }
a256e995 86 else {
87 if($mf_mtime < $mf_pl_mtime) {
88 push @fail_reasons, "./Makefile.PL is newer than ./Makefile";
89 }
90 if($mf_mtime < $optdeps_mtime) {
91 push @fail_reasons, "./$optdeps is newer than ./Makefile";
92 }
7159a456 93 }
94
95 if (@fail_reasons) {
96 print STDERR <<'EOE';
ab340f7f 97
ab340f7f 98!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
99======================== FATAL ERROR ===========================
100!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
101
102We have a number of reasons to believe that this is a development
103checkout and that you, the user, did not run `perl Makefile.PL`
104before using this code. You absolutely _must_ perform this step,
0424d17a 105to ensure you have all required dependencies present. Not doing
dc4600b2 106so often results in a lot of wasted time for other contributors
23b2c49b 107trying to assist you with spurious "its broken!" problems.
ab340f7f 108
0424d17a 109By default DBICs Makefile.PL turns all optional dependenciess into
110*HARD REQUIREMENTS*, in order to make sure that the entire test
111suite is executed, and no tests are skipped due to missing modules.
112If you for some reason need to disable this behavior - supply the
113--skip_author_deps option when running perl Makefile.PL
114
ab340f7f 115If you are seeing this message unexpectedly (i.e. you are in fact
dc4600b2 116attempting a regular installation be it through CPAN or manually),
117please report the situation to either the mailing list or to the
118irc channel as described in
ab340f7f 119
120http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT
121
ab340f7f 122The DBIC team
123
124
7159a456 125Reasons you received this message:
ab340f7f 126
127EOE
128
7159a456 129 foreach my $r (@fail_reasons) {
130 print STDERR " * $r\n";
131 }
132 print STDERR "\n\n\n";
133
1439bf15 134 require Time::HiRes;
135 Time::HiRes::sleep(0.005);
136 print STDOUT "\nBail out!\n";
ab340f7f 137 exit 1;
138 }
139}
140
dc4600b2 141# Mimic $Module::Install::AUTHOR
142sub is_author {
143
144 my $root = _find_co_root()
145 or return undef;
146
147 return (
148 ( not -d $root->subdir ('inc') )
149 or
39c9c72d 150 ( -e $root->subdir ('inc')->subdir ($^O eq 'VMS' ? '_author' : '.author') )
dc4600b2 151 );
152}
153
39c9c72d 154sub is_smoker {
1a08c5ed 155 return
156 ( ($ENV{TRAVIS}||'') eq 'true' )
157 ||
158 ( $ENV{AUTOMATED_TESTING} && ! $ENV{PERL5_CPANM_IS_RUNNING} && ! $ENV{RELEASE_TESTING} )
159 ;
39c9c72d 160}
161
162sub is_plain {
163 return (! __PACKAGE__->is_smoker && ! __PACKAGE__->is_author && ! $ENV{RELEASE_TESTING} )
164}
165
ab340f7f 166# Try to determine the root of a checkout/untar if possible
167# or return undef
168sub _find_co_root {
169
170 my @mod_parts = split /::/, (__PACKAGE__ . '.pm');
fd3d890d 171 my $rel_path = join ('/', @mod_parts); # %INC stores paths with / regardless of OS
ab340f7f 172
173 return undef unless ($INC{$rel_path});
174
175 # a bit convoluted, but what we do here essentially is:
176 # - get the file name of this particular module
177 # - do 'cd ..' as many times as necessary to get to t/lib/../..
178
179 my $root = dir ($INC{$rel_path});
fd3d890d 180 for (1 .. @mod_parts + 2) {
ab340f7f 181 $root = $root->parent;
182 }
183
184 return (-f $root->file ('Makefile.PL') )
185 ? $root
186 : undef
187 ;
188}
189
1901;