Commit | Line | Data |
394c3a46 |
1 | package strictures; |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | |
084caaf3 |
6 | use constant _PERL_LT_5_8_4 => ($] < 5.008004) ? 1 : 0; |
7 | |
9d152c1b |
8 | our $VERSION = '1.004003'; # 1.4.3 |
394c3a46 |
9 | |
10 | sub VERSION { |
11 | for ($_[1]) { |
12 | last unless defined && !ref && int != 1; |
13 | die "Major version specified as $_ - this is strictures version 1"; |
14 | } |
0925b84b |
15 | # disable this since Foo->VERSION(undef) correctly returns the version |
16 | # and that can happen either if our caller passes undef explicitly or |
17 | # because the for above autovivified $_[1] - I could make it stop but |
18 | # it's pointless since we don't want to blow up if the caller does |
19 | # something valid either. |
20 | no warnings 'uninitialized'; |
394c3a46 |
21 | shift->SUPER::VERSION(@_); |
22 | } |
23 | |
4f219885 |
24 | my $extra_load_states; |
ffedb166 |
25 | |
d7e82ccb |
26 | our $Smells_Like_VCS = (-e '.git' || -e '.svn' |
27 | || (-e '../../dist.ini' && (-e '../../.git' || -e '../../.svn'))); |
12b8f19b |
28 | |
394c3a46 |
29 | sub import { |
30 | strict->import; |
31 | warnings->import(FATAL => 'all'); |
084caaf3 |
32 | |
653f4377 |
33 | my $extra_tests = do { |
394c3a46 |
34 | if (exists $ENV{PERL_STRICTURES_EXTRA}) { |
084caaf3 |
35 | if (_PERL_LT_5_8_4 and $ENV{PERL_STRICTURES_EXTRA}) { |
0f96deac |
36 | die 'PERL_STRICTURES_EXTRA checks are not available on perls older than 5.8.4: ' |
084caaf3 |
37 | . "please unset \$ENV{PERL_STRICTURES_EXTRA}\n"; |
38 | } |
39 | $ENV{PERL_STRICTURES_EXTRA}; |
40 | } elsif (! _PERL_LT_5_8_4) { |
5ab06a4d |
41 | !!((caller)[1] =~ /^(?:t|xt|lib|blib)/ |
12b8f19b |
42 | and $Smells_Like_VCS) |
394c3a46 |
43 | } |
44 | }; |
653f4377 |
45 | if ($extra_tests) { |
4f219885 |
46 | $extra_load_states ||= do { |
47 | |
48 | my (%rv, @failed); |
49 | for my $mod (qw(indirect multidimensional bareword::filehandles)) { |
50 | eval "require $mod; \$rv{'$mod'} = 1;" or do { |
51 | push @failed, $mod; |
52 | |
53 | # courtesy of the 5.8 require bug |
54 | $mod =~ s|::|/|g; |
55 | delete $INC{"$mod.pm"}; |
56 | }; |
57 | } |
58 | |
59 | if (@failed) { |
60 | my $failed = join ' ', @failed; |
61 | print STDERR <<EOE; |
ffedb166 |
62 | strictures.pm extra testing active but couldn't load all modules. Missing were: |
63 | |
64 | $failed |
65 | |
0925b84b |
66 | Extra testing is auto-enabled in checkouts only, so if you're the author |
624cf8bb |
67 | of a strictures-using module you need to run: |
653f4377 |
68 | |
69 | cpan indirect multidimensional bareword::filehandles |
70 | |
71 | but these modules are not required by your users. |
084caaf3 |
72 | EOE |
4f219885 |
73 | } |
74 | |
75 | \%rv; |
76 | }; |
77 | |
78 | indirect->unimport(':fatal') if $extra_load_states->{indirect}; |
79 | multidimensional->unimport if $extra_load_states->{multidimensional}; |
80 | bareword::filehandles->unimport if $extra_load_states->{'bareword::filehandles'}; |
394c3a46 |
81 | } |
82 | } |
83 | |
84 | 1; |
85 | |
86 | __END__ |
87 | =head1 NAME |
88 | |
89 | strictures - turn on strict and make all warnings fatal |
90 | |
91 | =head1 SYNOPSIS |
92 | |
93 | use strictures 1; |
94 | |
95 | is equivalent to |
96 | |
97 | use strict; |
98 | use warnings FATAL => 'all'; |
99 | |
5ab06a4d |
100 | except when called from a file which matches: |
394c3a46 |
101 | |
5ab06a4d |
102 | (caller)[1] =~ /^(?:t|xt|lib|blib)/ |
394c3a46 |
103 | |
25877bf2 |
104 | and when either C<.git> or C<.svn> is present in the current directory (with |
d8c1c6b2 |
105 | the intention of only forcing extra tests on the author side) -- or when C<.git> |
25877bf2 |
106 | or C<.svn> is present two directories up along with C<dist.ini> (which would |
d8c1c6b2 |
107 | indicate we are in a C<dzil test> operation, via L<Dist::Zilla>) -- |
25877bf2 |
108 | or when the C<PERL_STRICTURES_EXTRA> environment variable is set, in which case |
394c3a46 |
109 | |
110 | use strictures 1; |
111 | |
112 | is equivalent to |
113 | |
114 | use strict; |
115 | use warnings FATAL => 'all'; |
116 | no indirect 'fatal'; |
653f4377 |
117 | no multidimensional; |
118 | no bareword::filehandles; |
394c3a46 |
119 | |
25877bf2 |
120 | Note that C<PERL_STRICTURES_EXTRA> may at some point add even more tests, with only a minor |
121 | version increase, but any changes to the effect of C<use strictures> in |
394c3a46 |
122 | normal mode will involve a major version bump. |
123 | |
0eb0d037 |
124 | If any of the extra testing modules are not present, L<strictures> will |
25877bf2 |
125 | complain loudly, once, via C<warn()>, and then shut up. But you really |
ffedb166 |
126 | should consider installing them, they're all great anti-footgun tools. |
17b03f2e |
127 | |
394c3a46 |
128 | =head1 DESCRIPTION |
129 | |
130 | I've been writing the equivalent of this module at the top of my code for |
131 | about a year now. I figured it was time to make it shorter. |
132 | |
25877bf2 |
133 | Things like the importer in C<use Moose> don't help me because they turn |
d8c1c6b2 |
134 | warnings on but don't make them fatal -- which from my point of view is |
2288278f |
135 | useless because I want an exception to tell me my code isn't warnings-clean. |
394c3a46 |
136 | |
137 | Any time I see a warning from my code, that indicates a mistake. |
138 | |
d8c1c6b2 |
139 | Any time my code encounters a mistake, I want a crash -- not spew to STDERR |
394c3a46 |
140 | and then unknown (and probably undesired) subsequent behaviour. |
141 | |
142 | I also want to ensure that obvious coding mistakes, like indirect object |
143 | syntax (and not so obvious mistakes that cause things to accidentally compile |
144 | as such) get caught, but not at the cost of an XS dependency and not at the |
145 | cost of blowing things up on another machine. |
146 | |
0eb0d037 |
147 | Therefore, L<strictures> turns on additional checking, but only when it thinks |
2288278f |
148 | it's running in a test file in a VCS checkout -- although if this causes |
93ae637e |
149 | undesired behaviour this can be overridden by setting the |
25877bf2 |
150 | C<PERL_STRICTURES_EXTRA> environment variable. |
394c3a46 |
151 | |
152 | If additional useful author side checks come to mind, I'll add them to the |
2288278f |
153 | C<PERL_STRICTURES_EXTRA> code path only -- this will result in a minor version increase (e.g. |
394c3a46 |
154 | 1.000000 to 1.001000 (1.1.0) or similar). Any fixes only to the mechanism of |
2288278f |
155 | this code will result in a sub-version increase (e.g. 1.000000 to 1.000001 |
394c3a46 |
156 | (1.0.1)). |
157 | |
25877bf2 |
158 | If the behaviour of C<use strictures> in normal mode changes in any way, that |
d8c1c6b2 |
159 | will constitute a major version increase -- and the code already checks |
394c3a46 |
160 | when its version is tested to ensure that |
161 | |
162 | use strictures 1; |
163 | |
164 | will continue to only introduce the current set of strictures even if 2.0 is |
165 | installed. |
eae006ee |
166 | |
167 | =head1 METHODS |
168 | |
169 | =head2 import |
170 | |
171 | This method does the setup work described above in L</DESCRIPTION> |
172 | |
173 | =head2 VERSION |
174 | |
25877bf2 |
175 | This method traps the C<< strictures->VERSION(1) >> call produced by a use line |
eae006ee |
176 | with a version number on it and does the version check. |
177 | |
f9df7e2e |
178 | =head1 EXTRA TESTING RATIONALE |
179 | |
25877bf2 |
180 | Every so often, somebody complains that they're deploying via C<git pull> |
d8c1c6b2 |
181 | and that they don't want L<strictures> to enable itself in this case -- and that |
f9df7e2e |
182 | setting C<PERL_STRICTURES_EXTRA> to 0 isn't acceptable (additional ways to |
183 | disable extra testing would be welcome but the discussion never seems to get |
184 | that far). |
185 | |
186 | In order to allow us to skip a couple of stages and get straight to a |
187 | productive conversation, here's my current rationale for turning the |
188 | extra testing on via a heuristic: |
189 | |
190 | The extra testing is all stuff that only ever blows up at compile time; |
2288278f |
191 | this is intentional. So the oft-raised concern that it's different code being |
d8c1c6b2 |
192 | tested is only sort of the case -- none of the modules involved affect the |
f9df7e2e |
193 | final optree to my knowledge, so the author gets some additional compile |
194 | time crashes which he/she then fixes, and the rest of the testing is |
195 | completely valid for all environments. |
196 | |
d8c1c6b2 |
197 | The point of the extra testing -- especially C<no indirect> -- is to catch |
f9df7e2e |
198 | mistakes that newbie users won't even realise are mistakes without |
199 | help. For example, |
200 | |
201 | foo { ... }; |
202 | |
d8c1c6b2 |
203 | where foo is an & prototyped sub that you forgot to import -- this is |
9a363fed |
204 | pernicious to track down since all I<seems> fine until it gets called |
f9df7e2e |
205 | and you get a crash. Worse still, you can fail to have imported it due |
206 | to a circular require, at which point you have a load order dependent |
9a363fed |
207 | bug which I've seen before now I<only> show up in production due to tiny |
f9df7e2e |
208 | differences between the production and the development environment. I wrote |
209 | L<http://shadow.cat/blog/matt-s-trout/indirect-but-still-fatal/> to explain |
210 | this particular problem before L<strictures> itself existed. |
211 | |
2288278f |
212 | As such, in my experience so far L<strictures>' extra testing has |
9a363fed |
213 | I<avoided> production versus development differences, not caused them. |
f9df7e2e |
214 | |
0eb0d037 |
215 | Additionally, L<strictures>' policy is very much "try and provide as much |
d8c1c6b2 |
216 | protection as possible for newbies -- who won't think about whether there's |
217 | an option to turn on or not" -- so having only the environment variable |
f9df7e2e |
218 | is not sufficient to achieve that (I get to explain that you need to add |
d8c1c6b2 |
219 | C<use strict> at least once a week on freenode #perl -- newbies sometimes |
f9df7e2e |
220 | completely skip steps because they don't understand that that step |
221 | is important). |
222 | |
d8c1c6b2 |
223 | I make no claims that the heuristic is perfect -- it's already been evolved |
f9df7e2e |
224 | significantly over time, especially for 1.004 where we changed things to |
0eb0d037 |
225 | ensure it only fires on files in your checkout (rather than L<strictures>-using |
f9df7e2e |
226 | modules you happened to have installed, which was just silly). However, I |
227 | hope the above clarifies why a heuristic approach is not only necessary but |
2288278f |
228 | desirable from a point of view of providing new users with as much safety as possible, |
f9df7e2e |
229 | and will allow any future discussion on the subject to focus on "how do we |
230 | minimise annoyance to people deploying from checkouts intentionally". |
231 | |
eae006ee |
232 | =head1 COMMUNITY AND SUPPORT |
233 | |
234 | =head2 IRC channel |
235 | |
236 | irc.perl.org #toolchain |
237 | |
238 | (or bug 'mst' in query on there or freenode) |
239 | |
240 | =head2 Git repository |
241 | |
242 | Gitweb is on http://git.shadowcat.co.uk/ and the clone URL is: |
243 | |
244 | git clone git://git.shadowcat.co.uk/p5sagit/strictures.git |
245 | |
91be28bc |
246 | The web interface to the repository is at: |
247 | |
248 | http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/strictures.git |
249 | |
eae006ee |
250 | =head1 AUTHOR |
251 | |
d81f898d |
252 | mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk> |
eae006ee |
253 | |
254 | =head1 CONTRIBUTORS |
255 | |
256 | None required yet. Maybe this module is perfect (hahahahaha ...). |
257 | |
258 | =head1 COPYRIGHT |
259 | |
260 | Copyright (c) 2010 the strictures L</AUTHOR> and L</CONTRIBUTORS> |
261 | as listed above. |
262 | |
263 | =head1 LICENSE |
264 | |
265 | This library is free software and may be distributed under the same terms |
266 | as perl itself. |
267 | |
268 | =cut |