Commit | Line | Data |
394c3a46 |
1 | package strictures; |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | |
0925b84b |
6 | our $VERSION = '1.001001'; # 1.1.1 |
394c3a46 |
7 | |
8 | sub VERSION { |
9 | for ($_[1]) { |
10 | last unless defined && !ref && int != 1; |
11 | die "Major version specified as $_ - this is strictures version 1"; |
12 | } |
0925b84b |
13 | # disable this since Foo->VERSION(undef) correctly returns the version |
14 | # and that can happen either if our caller passes undef explicitly or |
15 | # because the for above autovivified $_[1] - I could make it stop but |
16 | # it's pointless since we don't want to blow up if the caller does |
17 | # something valid either. |
18 | no warnings 'uninitialized'; |
394c3a46 |
19 | shift->SUPER::VERSION(@_); |
20 | } |
21 | |
22 | sub import { |
23 | strict->import; |
24 | warnings->import(FATAL => 'all'); |
25 | my $do_indirect = do { |
26 | if (exists $ENV{PERL_STRICTURES_EXTRA}) { |
27 | $ENV{PERL_STRICTURES_EXTRA} |
28 | } else { |
dca7f184 |
29 | !!($0 =~ /^x?t\/.*(?:load|compile|coverage|use_ok).*\.t$/ |
30 | and (-e '.git' or -e '.svn')) |
394c3a46 |
31 | } |
32 | }; |
33 | if ($do_indirect) { |
34 | if (eval { require indirect; 1 }) { |
eae006ee |
35 | indirect->unimport(':fatal'); |
394c3a46 |
36 | } else { |
0925b84b |
37 | die "strictures.pm extra testing active but couldn't load indirect.pm |
38 | Extra testing is auto-enabled in checkouts only, so if you're the author |
39 | of a strictures using module you should 'cpan indirect' but the module |
40 | is not required by your users. |
41 | Error loading indirect.pm was: $@"; |
394c3a46 |
42 | } |
43 | } |
44 | } |
45 | |
46 | 1; |
47 | |
48 | __END__ |
49 | =head1 NAME |
50 | |
51 | strictures - turn on strict and make all warnings fatal |
52 | |
53 | =head1 SYNOPSIS |
54 | |
55 | use strictures 1; |
56 | |
57 | is equivalent to |
58 | |
59 | use strict; |
60 | use warnings FATAL => 'all'; |
61 | |
62 | except when called from a file where $0 matches: |
63 | |
dca7f184 |
64 | /^x?t\/.*(?:load|compile|coverage|use_ok).*\.t$/ |
394c3a46 |
65 | |
dca7f184 |
66 | and when either '.git' or '.svn' is present in the current directory (with |
67 | the intention of only forcing extra tests on the author side) - or when the |
68 | PERL_STRICTURES_EXTRA environment variable is set, in which case |
394c3a46 |
69 | |
70 | use strictures 1; |
71 | |
72 | is equivalent to |
73 | |
74 | use strict; |
75 | use warnings FATAL => 'all'; |
76 | no indirect 'fatal'; |
77 | |
78 | Note that _EXTRA may at some point add even more tests, with only a minor |
79 | version increase, but any changes to the effect of 'use strictures' in |
80 | normal mode will involve a major version bump. |
81 | |
17b03f2e |
82 | Be aware: THIS MEANS INDIRECT IS REQUIRED FOR AUTHORS OF STRICTURES USING |
83 | CODE - but not by end users thereof. |
84 | |
394c3a46 |
85 | =head1 DESCRIPTION |
86 | |
87 | I've been writing the equivalent of this module at the top of my code for |
88 | about a year now. I figured it was time to make it shorter. |
89 | |
90 | Things like the importer in 'use Moose' don't help me because they turn |
91 | warnings on but don't make them fatal - which from my point of view is |
92 | useless because I want an exception to tell me my code isn't warnings clean. |
93 | |
94 | Any time I see a warning from my code, that indicates a mistake. |
95 | |
96 | Any time my code encounters a mistake, I want a crash - not spew to STDERR |
97 | and then unknown (and probably undesired) subsequent behaviour. |
98 | |
99 | I also want to ensure that obvious coding mistakes, like indirect object |
100 | syntax (and not so obvious mistakes that cause things to accidentally compile |
101 | as such) get caught, but not at the cost of an XS dependency and not at the |
102 | cost of blowing things up on another machine. |
103 | |
104 | Therefore, strictures turns on indirect checking only when it thinks it's |
105 | running in a compilation (or pod coverage) test - though if this causes |
106 | undesired behaviour this can be overriden by setting the |
107 | PERL_STRICTURES_EXTRA environment variable. |
108 | |
109 | If additional useful author side checks come to mind, I'll add them to the |
110 | _EXTRA code path only - this will result in a minor version increase (i.e. |
111 | 1.000000 to 1.001000 (1.1.0) or similar). Any fixes only to the mechanism of |
112 | this code will result in a subversion increas (i.e. 1.000000 to 1.000001 |
113 | (1.0.1)). |
114 | |
115 | If the behaviour of 'use strictures' in normal mode changes in any way, that |
116 | will constitute a major version increase - and the code already checks |
117 | when its version is tested to ensure that |
118 | |
119 | use strictures 1; |
120 | |
121 | will continue to only introduce the current set of strictures even if 2.0 is |
122 | installed. |
eae006ee |
123 | |
124 | =head1 METHODS |
125 | |
126 | =head2 import |
127 | |
128 | This method does the setup work described above in L</DESCRIPTION> |
129 | |
130 | =head2 VERSION |
131 | |
132 | This method traps the strictures->VERSION(1) call produced by a use line |
133 | with a version number on it and does the version check. |
134 | |
135 | =head1 COMMUNITY AND SUPPORT |
136 | |
137 | =head2 IRC channel |
138 | |
139 | irc.perl.org #toolchain |
140 | |
141 | (or bug 'mst' in query on there or freenode) |
142 | |
143 | =head2 Git repository |
144 | |
145 | Gitweb is on http://git.shadowcat.co.uk/ and the clone URL is: |
146 | |
147 | git clone git://git.shadowcat.co.uk/p5sagit/strictures.git |
148 | |
149 | =head1 AUTHOR |
150 | |
151 | Matt S. Trout <mst@shadowcat.co.uk> |
152 | |
153 | =head1 CONTRIBUTORS |
154 | |
155 | None required yet. Maybe this module is perfect (hahahahaha ...). |
156 | |
157 | =head1 COPYRIGHT |
158 | |
159 | Copyright (c) 2010 the strictures L</AUTHOR> and L</CONTRIBUTORS> |
160 | as listed above. |
161 | |
162 | =head1 LICENSE |
163 | |
164 | This library is free software and may be distributed under the same terms |
165 | as perl itself. |
166 | |
167 | =cut |