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 | |
4b6c11e3 |
8 | our $VERSION = '1.004000'; # 1.4.0 |
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 | |
ffedb166 |
24 | my $extras_load_warned; |
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) { |
ffedb166 |
46 | my @failed; |
47 | if (eval { require indirect; 1 }) { |
eae006ee |
48 | indirect->unimport(':fatal'); |
ffedb166 |
49 | } else { |
50 | push @failed, 'indirect'; |
51 | } |
52 | if (eval { require multidimensional; 1 }) { |
653f4377 |
53 | multidimensional->unimport; |
ffedb166 |
54 | } else { |
55 | push @failed, 'multidimensional'; |
56 | } |
57 | if (eval { require bareword::filehandles; 1 }) { |
653f4377 |
58 | bareword::filehandles->unimport; |
394c3a46 |
59 | } else { |
ffedb166 |
60 | push @failed, 'bareword::filehandles'; |
61 | } |
62 | if (@failed and not $extras_load_warned++) { |
63 | my $failed = join ' ', @failed; |
64 | warn <<EOE; |
65 | strictures.pm extra testing active but couldn't load all modules. Missing were: |
66 | |
67 | $failed |
68 | |
0925b84b |
69 | Extra testing is auto-enabled in checkouts only, so if you're the author |
653f4377 |
70 | of a strictures using module you need to run: |
71 | |
72 | cpan indirect multidimensional bareword::filehandles |
73 | |
74 | but these modules are not required by your users. |
084caaf3 |
75 | EOE |
394c3a46 |
76 | } |
77 | } |
78 | } |
79 | |
80 | 1; |
81 | |
82 | __END__ |
83 | =head1 NAME |
84 | |
85 | strictures - turn on strict and make all warnings fatal |
86 | |
87 | =head1 SYNOPSIS |
88 | |
89 | use strictures 1; |
90 | |
91 | is equivalent to |
92 | |
93 | use strict; |
94 | use warnings FATAL => 'all'; |
95 | |
5ab06a4d |
96 | except when called from a file which matches: |
394c3a46 |
97 | |
5ab06a4d |
98 | (caller)[1] =~ /^(?:t|xt|lib|blib)/ |
394c3a46 |
99 | |
dca7f184 |
100 | and when either '.git' or '.svn' is present in the current directory (with |
101 | the intention of only forcing extra tests on the author side) - or when the |
102 | PERL_STRICTURES_EXTRA environment variable is set, in which case |
394c3a46 |
103 | |
104 | use strictures 1; |
105 | |
106 | is equivalent to |
107 | |
108 | use strict; |
109 | use warnings FATAL => 'all'; |
110 | no indirect 'fatal'; |
653f4377 |
111 | no multidimensional; |
112 | no bareword::filehandles; |
394c3a46 |
113 | |
114 | Note that _EXTRA may at some point add even more tests, with only a minor |
115 | version increase, but any changes to the effect of 'use strictures' in |
116 | normal mode will involve a major version bump. |
117 | |
ffedb166 |
118 | If any of the extra testing modules are not present, strictures will |
119 | complain loudly, once, via warn(), and then shut up. But you really |
120 | should consider installing them, they're all great anti-footgun tools. |
17b03f2e |
121 | |
394c3a46 |
122 | =head1 DESCRIPTION |
123 | |
124 | I've been writing the equivalent of this module at the top of my code for |
125 | about a year now. I figured it was time to make it shorter. |
126 | |
127 | Things like the importer in 'use Moose' don't help me because they turn |
128 | warnings on but don't make them fatal - which from my point of view is |
129 | useless because I want an exception to tell me my code isn't warnings clean. |
130 | |
131 | Any time I see a warning from my code, that indicates a mistake. |
132 | |
133 | Any time my code encounters a mistake, I want a crash - not spew to STDERR |
134 | and then unknown (and probably undesired) subsequent behaviour. |
135 | |
136 | I also want to ensure that obvious coding mistakes, like indirect object |
137 | syntax (and not so obvious mistakes that cause things to accidentally compile |
138 | as such) get caught, but not at the cost of an XS dependency and not at the |
139 | cost of blowing things up on another machine. |
140 | |
0e8766d0 |
141 | Therefore, strictures turns on additional checking, but only when it thinks |
142 | it's running in a test file in a VCS checkout - though if this causes |
93ae637e |
143 | undesired behaviour this can be overridden by setting the |
394c3a46 |
144 | PERL_STRICTURES_EXTRA environment variable. |
145 | |
146 | If additional useful author side checks come to mind, I'll add them to the |
147 | _EXTRA code path only - this will result in a minor version increase (i.e. |
148 | 1.000000 to 1.001000 (1.1.0) or similar). Any fixes only to the mechanism of |
149 | this code will result in a subversion increas (i.e. 1.000000 to 1.000001 |
150 | (1.0.1)). |
151 | |
152 | If the behaviour of 'use strictures' in normal mode changes in any way, that |
153 | will constitute a major version increase - and the code already checks |
154 | when its version is tested to ensure that |
155 | |
156 | use strictures 1; |
157 | |
158 | will continue to only introduce the current set of strictures even if 2.0 is |
159 | installed. |
eae006ee |
160 | |
161 | =head1 METHODS |
162 | |
163 | =head2 import |
164 | |
165 | This method does the setup work described above in L</DESCRIPTION> |
166 | |
167 | =head2 VERSION |
168 | |
169 | This method traps the strictures->VERSION(1) call produced by a use line |
170 | with a version number on it and does the version check. |
171 | |
172 | =head1 COMMUNITY AND SUPPORT |
173 | |
174 | =head2 IRC channel |
175 | |
176 | irc.perl.org #toolchain |
177 | |
178 | (or bug 'mst' in query on there or freenode) |
179 | |
180 | =head2 Git repository |
181 | |
182 | Gitweb is on http://git.shadowcat.co.uk/ and the clone URL is: |
183 | |
184 | git clone git://git.shadowcat.co.uk/p5sagit/strictures.git |
185 | |
186 | =head1 AUTHOR |
187 | |
d81f898d |
188 | mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk> |
eae006ee |
189 | |
190 | =head1 CONTRIBUTORS |
191 | |
192 | None required yet. Maybe this module is perfect (hahahahaha ...). |
193 | |
194 | =head1 COPYRIGHT |
195 | |
196 | Copyright (c) 2010 the strictures L</AUTHOR> and L</CONTRIBUTORS> |
197 | as listed above. |
198 | |
199 | =head1 LICENSE |
200 | |
201 | This library is free software and may be distributed under the same terms |
202 | as perl itself. |
203 | |
204 | =cut |