Commit | Line | Data |
4bea1fe7 |
1 | package # hide from PAUSE |
39c9c72d |
2 | DBICTest::RunMode; |
ab340f7f |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
4bea1fe7 |
7 | BEGIN { |
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 |
18 | use Path::Class qw/file dir/; |
9b871b00 |
19 | use 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 |
27 | my $tmpdir; |
28 | sub 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 | # |
62 | sub _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 | |
98 | |
99 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
100 | ======================== FATAL ERROR =========================== |
101 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
102 | |
103 | We have a number of reasons to believe that this is a development |
104 | checkout and that you, the user, did not run `perl Makefile.PL` |
105 | before using this code. You absolutely _must_ perform this step, |
0424d17a |
106 | to ensure you have all required dependencies present. Not doing |
dc4600b2 |
107 | so often results in a lot of wasted time for other contributors |
108 | trying to assit you with spurious "its broken!" problems. |
ab340f7f |
109 | |
0424d17a |
110 | By default DBICs Makefile.PL turns all optional dependenciess into |
111 | *HARD REQUIREMENTS*, in order to make sure that the entire test |
112 | suite is executed, and no tests are skipped due to missing modules. |
113 | If you for some reason need to disable this behavior - supply the |
114 | --skip_author_deps option when running perl Makefile.PL |
115 | |
ab340f7f |
116 | If you are seeing this message unexpectedly (i.e. you are in fact |
dc4600b2 |
117 | attempting a regular installation be it through CPAN or manually), |
118 | please report the situation to either the mailing list or to the |
119 | irc channel as described in |
ab340f7f |
120 | |
121 | http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT |
122 | |
ab340f7f |
123 | The DBIC team |
124 | |
125 | |
7159a456 |
126 | Reasons you received this message: |
ab340f7f |
127 | |
128 | EOE |
129 | |
7159a456 |
130 | foreach my $r (@fail_reasons) { |
131 | print STDERR " * $r\n"; |
132 | } |
133 | print STDERR "\n\n\n"; |
134 | |
ab340f7f |
135 | exit 1; |
136 | } |
137 | } |
138 | |
dc4600b2 |
139 | # Mimic $Module::Install::AUTHOR |
140 | sub is_author { |
141 | |
142 | my $root = _find_co_root() |
143 | or return undef; |
144 | |
145 | return ( |
146 | ( not -d $root->subdir ('inc') ) |
147 | or |
39c9c72d |
148 | ( -e $root->subdir ('inc')->subdir ($^O eq 'VMS' ? '_author' : '.author') ) |
dc4600b2 |
149 | ); |
150 | } |
151 | |
39c9c72d |
152 | sub is_smoker { |
1a08c5ed |
153 | return |
154 | ( ($ENV{TRAVIS}||'') eq 'true' ) |
155 | || |
156 | ( $ENV{AUTOMATED_TESTING} && ! $ENV{PERL5_CPANM_IS_RUNNING} && ! $ENV{RELEASE_TESTING} ) |
157 | ; |
39c9c72d |
158 | } |
159 | |
160 | sub is_plain { |
161 | return (! __PACKAGE__->is_smoker && ! __PACKAGE__->is_author && ! $ENV{RELEASE_TESTING} ) |
162 | } |
163 | |
ab340f7f |
164 | # Try to determine the root of a checkout/untar if possible |
165 | # or return undef |
166 | sub _find_co_root { |
167 | |
168 | my @mod_parts = split /::/, (__PACKAGE__ . '.pm'); |
fd3d890d |
169 | my $rel_path = join ('/', @mod_parts); # %INC stores paths with / regardless of OS |
ab340f7f |
170 | |
171 | return undef unless ($INC{$rel_path}); |
172 | |
173 | # a bit convoluted, but what we do here essentially is: |
174 | # - get the file name of this particular module |
175 | # - do 'cd ..' as many times as necessary to get to t/lib/../.. |
176 | |
177 | my $root = dir ($INC{$rel_path}); |
fd3d890d |
178 | for (1 .. @mod_parts + 2) { |
ab340f7f |
179 | $root = $root->parent; |
180 | } |
181 | |
182 | return (-f $root->file ('Makefile.PL') ) |
183 | ? $root |
184 | : undef |
185 | ; |
186 | } |
187 | |
188 | 1; |