File Coverage

blib/lib/sanity.pm
Criterion Covered Total %
statement 163 210 77.6
branch 70 116 60.3
condition 6 19 31.5
subroutine 26 30 86.6
pod 0 9 0.0
total 265 384 69.0


line stmt bran cond sub pod time code
1             package sanity;
2              
3             our $AUTHORITY = 'cpan:BBYRD'; # AUTHORITY
4             our $VERSION = '1.03'; # VERSION
5             # ABSTRACT: The ONLY meta pragma you'll ever need!
6              
7             # use feature has to be difficult...
8             our $VER_PACK;
9 1     1   21878 BEGIN { $VER_PACK = sprintf(":%vd", $^V); }
10              
11             # Eat our own dog food
12 1     1   511 use utf8;
  1         7  
  1         5  
13 1     1   83 use strict qw(subs vars);
  1         1  
  1         36  
14 1     1   4 no strict 'refs';
  1         2  
  1         23  
15             #use feature ($VER_PACK);
16 1     1   4 use warnings FATAL => 'all';
  1         1  
  1         41  
17 1     1   3 no warnings qw(uninitialized);
  1         2  
  1         31  
18 1     1   504 no if $] >= 5.017011, warnings => 'experimental::smartmatch';
  1         7  
  1         4  
19              
20             # Need this for some of the bit math
21 1     1   469842 use bigint; ### LAZY: I should probably be using Math::BigInt... ###
  1         5266  
  1         4  
22 1     1   31012 use sanity::BaseCalc; ### FIXME: Temporary until Math::BaseCalc fix (RT #77198) ###
  1         3  
  1         42  
23              
24 1     1   540 use List::MoreUtils qw(any all none uniq);
  1         874  
  1         79  
25              
26             # Useful for importing modules, including stuff like Carp and its exports
27 1     1   472 use Import::Into v1.1.0;
  1         2579  
  1         15  
28              
29             my $base90 = [0..9, 'A'..'Z', 'a'..'z', split(//, '#$%&()*+.,-/:;<=>?@[]^_`{|}~')]; # no !, ', ", or \
30             my $base48900 = [
31             @$base90,
32             # see printuni.pl for details
33             map { chr } (
34             0xa2..0xac, 0xae..0x2e9, 0x2ec..0x2ff, 0x370..0x377, 0x37a..0x37e, 0x384..0x38a, 0x38c, 0x38e..0x3a1, 0x3a3..0x3e1,
35             0x3f0..0x482, 0x48a..0x513, 0x531..0x556, 0x559..0x55f, 0x561..0x587, 0x589, 0x58a, 0x5be, 0x5c0,
36             0x5c3, 0x5c6, 0x5d0..0x5ea, 0x5f0..0x5f4, 0x606..0x60f, 0x61b, 0x61e..0x64a, 0x660..0x66f,
37             0x671..0x6d5, 0x6de, 0x6e5, 0x6e6, 0x6e9, 0x6ee..0x70d, 0x710, 0x712..0x72f, 0x74d..0x7b1,
38             0x7c0..0x7ea, 0x7f4..0x7fa, 0x900..0x902, 0x904..0x93a, 0x93d, 0x941..0x948, 0x950, 0x955..0x977,
39             0x979..0x97f, 0x981, 0x985..0x98c, 0x98f, 0x990, 0x993..0x9a8, 0x9aa..0x9b0, 0x9b2, 0x9b6..0x9b9,
40             0x9bd, 0x9c1..0x9c4, 0x9ce, 0x9dc, 0x9dd, 0x9df..0x9e3, 0x9e6..0x9fb, 0xa01, 0xa02, 0xa05..0xa0a,
41             0xa0f, 0xa10, 0xa13..0xa28, 0xa2a..0xa30, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39, 0xa41, 0xa42, 0xa47, 0xa48,
42             0xa4b, 0xa4c, 0xa51, 0xa59..0xa5c, 0xa5e, 0xa66..0xa75, 0xa81, 0xa82, 0xa85..0xa8d, 0xa8f..0xa91,
43             0xa93..0xaa8, 0xaaa..0xab0, 0xab2, 0xab3, 0xab5..0xab9, 0xabd, 0xac1..0xac5, 0xac7, 0xac8, 0xad0,
44             0xae0..0xae3, 0xae6..0xaef, 0xaf1, 0xb01, 0xb05..0xb0c, 0xb0f, 0xb10, 0xb13..0xb28, 0xb2a..0xb30,
45             0xb32, 0xb33, 0xb35..0xb39, 0xb3d, 0xb3f, 0xb41..0xb44, 0xb56, 0xb5c, 0xb5d, 0xb5f..0xb63,
46             0xb66..0xb77, 0xb82, 0xb83, 0xb85..0xb8a, 0xb8e..0xb90, 0xb92..0xb95, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f,
47             0xba3, 0xba4, 0xba8..0xbaa, 0xbae..0xbb9, 0xbc0, 0xbd0, 0xbe6..0xbfa, 0xc05..0xc0c, 0xc0e..0xc10,
48             0xc12..0xc28, 0xc2a..0xc33, 0xc35..0xc39, 0xc3d..0xc40, 0xc46..0xc48, 0xc4a..0xc4c, 0xc58, 0xc59, 0xc60..0xc63,
49             0xc66..0xc6f, 0xc78..0xc7f, 0xc85..0xc8c, 0xc8e..0xc90, 0xc92..0xca8, 0xcaa..0xcb3, 0xcb5..0xcb9, 0xcbd,
50             0xcbf, 0xcc6, 0xccc, 0xcde, 0xce0..0xce3, 0xce6..0xcef, 0xcf1, 0xcf2, 0xd05..0xd0c,
51             0xd0e..0xd10, 0xd12..0xd3a, 0xd3d, 0xd41..0xd44, 0xd4e, 0xd60..0xd63, 0xd66..0xd75, 0xd79..0xd7f,
52             0xd85..0xd96, 0xd9a..0xdb1, 0xdb3..0xdbb, 0xdbd, 0xdc0..0xdc6, 0xdd2..0xdd4, 0xdd6, 0xdf4,
53             0xe01..0xe37, 0xe3f..0xe47, 0xe4c..0xe5b, 0xe81, 0xe82, 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d,
54             0xe94..0xe97, 0xe99..0xe9f, 0xea1..0xea3, 0xea5, 0xea7, 0xeaa, 0xeab, 0xead..0xeb7, 0xebb..0xebd,
55             0xec0..0xec4, 0xec6, 0xecc, 0xecd, 0xed0..0xed9, 0xedc, 0xedd, 0xf00..0xf17, 0xf1a..0xf34, 0xf36,
56             0xf38, 0xf3a..0xf3d, 0xf40..0xf47, 0xf49..0xf6c, 0xf73, 0xf75..0xf79, 0xf7e, 0xf81,
57             0xf85, 0xf88..0xf97, 0xf99..0xfbc, 0xfbe..0xfc5, 0xfc7..0xfcc, 0xfce..0xfda, 0x10fb, 0x1100..0x115e,
58             0x1161..0x1248, 0x124a..0x124d, 0x1250..0x1256, 0x1258, 0x125a..0x125d, 0x1260..0x1288, 0x128a..0x128d, 0x1290..0x12b0,
59             0x12b2..0x12b5, 0x12b8..0x12be, 0x12c0, 0x12c2..0x12c5, 0x12c8..0x12d6, 0x12d8..0x1310, 0x1312..0x1315, 0x1318..0x135a,
60             0x1360..0x137c, 0x1380..0x1399, 0x13a0..0x13f4, 0x1400..0x167f, 0x1681..0x169c, 0x16a0..0x16f0, 0x1735, 0x1736, 0x1780..0x17b3,
61             0x17b7..0x17bd, 0x17c6, 0x17c9..0x17d1, 0x17d3..0x17dc, 0x17e0..0x17e9, 0x17f0..0x17f9, 0x1800..0x180d, 0x1810..0x1819,
62             0x1820..0x1877, 0x1880..0x18a8, 0x18aa, 0x1950..0x196d, 0x1970..0x1974, 0x1980..0x19ab, 0x19c1..0x19c7, 0x19d0..0x19da,
63             0x19de..0x19ff, 0x1d00..0x1dbf, 0x1e00..0x1f15, 0x1f18..0x1f1d, 0x1f20..0x1f45, 0x1f48..0x1f4d, 0x1f50..0x1f57, 0x1f59,
64             0x1f5b, 0x1f5d, 0x1f5f..0x1f7d, 0x1f80..0x1fb4, 0x1fb6..0x1fc4, 0x1fc6..0x1fd3, 0x1fd6..0x1fdb, 0x1fdd..0x1fef,
65             0x1ff2..0x1ff4, 0x1ff6..0x1ffe, 0x2010..0x2027, 0x2030..0x205e, 0x2070, 0x2071, 0x2074..0x208e, 0x2090..0x209c, 0x20a0..0x20b9,
66             0x2100..0x2189, 0x2190..0x22bf, 0x2500..0x257f, 0x25a0..0x266f, 0x2701..0x27bf, 0x2800..0x28ff, 0x2c60..0x2c7f, 0x2d30..0x2d65,
67             0x2d6f, 0x2d70, 0x2d80..0x2d96, 0x2da0..0x2da6, 0x2da8..0x2dae, 0x2db0..0x2db6, 0x2db8..0x2dbe, 0x2dc0..0x2dc6, 0x2dc8..0x2dce,
68             0x2dd0..0x2dd6, 0x2dd8..0x2dde, 0x2e80..0x2e99, 0x2e9b..0x2ef3, 0x2ff0..0x2ffb, 0x3001..0x3029, 0x3030..0x303f, 0x3041..0x3096,
69             0x309b..0x30ff, 0x3131..0x3163, 0x3165..0x318e, 0x3190..0x319f, 0x31c0..0x31e3, 0x31f0..0x321e, 0x3220..0x32fe, 0x3300..0x4db5,
70             0x4e00..0x9fcb, 0xa000..0xa48c, 0xa490..0xa4c6, 0xa500..0xa62b, 0xa840..0xa877, 0xac00..0xd7a3, 0xf900..0xfa2d, 0xfa30..0xfa6d,
71             0xfa70..0xfad9, 0xfb00..0xfb06, 0xfb13..0xfb17, 0xfb1d, 0xfb1f..0xfb36, 0xfb38..0xfb3c, 0xfb3e, 0xfb40, 0xfb41,
72             0xfb43, 0xfb44, 0xfb46..0xfb4f, 0xfe10..0xfe19, 0xfe30..0xfe52, 0xfe54..0xfe66, 0xfe68..0xfe6b, 0xff01..0xff9f, 0xffa1..0xffbe,
73             0xffc2..0xffc7, 0xffca..0xffcf, 0xffd2..0xffd7, 0xffda..0xffdc, 0xffe0..0xffe6, 0xffe8..0xffee,
74             )
75             ];
76             my $calc90 = sanity::BaseCalc->new(digits => $base90);
77             my $calc48900 = sanity::BaseCalc->new(digits => $base48900);
78              
79             my @FLAGS = (
80             # Perl.h HINTS (Bits 0-31)
81             # (matches ordering of $^H)
82             qw(
83             integer
84             strict/refs
85             locale
86             bytes
87             XXX:ARRAY_BASE
88             XXX:V_VMSISH1
89             XXX:V_VMSISH2
90             XXX:V_VMSISH3
91             XXX:BLOCK_SCOPE
92             strict/subs
93             strict/vars
94             feature/HINT/unicode
95             XXX:overload/integer
96             XXX:overload/float
97             XXX:overload/binary
98             XXX:overload/q
99             XXX:overload/qr
100             XXX:LOCALIZE_HH
101             XXX:LEXICAL_IO_IN
102             XXX:LEXICAL_IO_OUT
103             re/taint
104             re/eval
105             filetest
106             utf8
107             NO:overloading
108             XXX:RE_FLAGS
109             XXX:FEATURE_BIT1
110             XXX:FEATURE_BIT2
111             XXX:FEATURE_BIT3
112             XXX:HINT_0x20000000
113             XXX:HINT_0x40000000
114             XXX:HINT_0x80000000
115             ),
116              
117             # warnings.pm (Bits 32-160)
118             # (matches REVERSE ordering of $^{WARNING_BITS} << 32)
119             qw(
120             MULTI:warnings/all MULTI:warnings/all/FATAL
121             warnings/closure MULTI:warnings/closure/FATAL
122             warnings/deprecated MULTI:warnings/deprecated/FATAL
123             warnings/exiting MULTI:warnings/exiting/FATAL
124             warnings/glob MULTI:warnings/glob/FATAL
125             MULTI:warnings/io MULTI:warnings/io/FATAL
126             warnings/closed MULTI:warnings/closed/FATAL
127             warnings/exec MULTI:warnings/exec/FATAL
128             warnings/layer MULTI:warnings/layer/FATAL
129             warnings/newline MULTI:warnings/newline/FATAL
130             warnings/pipe MULTI:warnings/pipe/FATAL
131             warnings/unopened MULTI:warnings/unopened/FATAL
132             warnings/misc MULTI:warnings/misc/FATAL
133             warnings/numeric MULTI:warnings/numeric/FATAL
134             warnings/once MULTI:warnings/once/FATAL
135             warnings/overflow MULTI:warnings/overflow/FATAL
136             warnings/pack MULTI:warnings/pack/FATAL
137             warnings/portable MULTI:warnings/portable/FATAL
138             warnings/recursion MULTI:warnings/recursion/FATAL
139             warnings/redefine MULTI:warnings/redefine/FATAL
140             warnings/regexp MULTI:warnings/regexp/FATAL
141             MULTI:warnings/severe MULTI:warnings/severe/FATAL
142             warnings/debugging MULTI:warnings/debugging/FATAL
143             warnings/inplace MULTI:warnings/inplace/FATAL
144             warnings/internal MULTI:warnings/internal/FATAL
145             warnings/malloc MULTI:warnings/malloc/FATAL
146             warnings/signal MULTI:warnings/signal/FATAL
147             warnings/substr MULTI:warnings/substr/FATAL
148             MULTI:warnings/syntax MULTI:warnings/syntax/FATAL
149             warnings/ambiguous MULTI:warnings/ambiguous/FATAL
150             warnings/bareword MULTI:warnings/bareword/FATAL
151             warnings/digit MULTI:warnings/digit/FATAL
152             warnings/parenthesis MULTI:warnings/parenthesis/FATAL
153             warnings/precedence MULTI:warnings/precedence/FATAL
154             warnings/printf MULTI:warnings/printf/FATAL
155             warnings/prototype MULTI:warnings/prototype/FATAL
156             warnings/qw MULTI:warnings/qw/FATAL
157             warnings/reserved MULTI:warnings/reserved/FATAL
158             warnings/semicolon MULTI:warnings/semicolon/FATAL
159             warnings/taint MULTI:warnings/taint/FATAL
160             warnings/threads MULTI:warnings/threads/FATAL
161             warnings/uninitialized MULTI:warnings/uninitialized/FATAL
162             warnings/unpack MULTI:warnings/unpack/FATAL
163             warnings/untie MULTI:warnings/untie/FATAL
164             MULTI:warnings/utf8 MULTI:warnings/utf8/FATAL
165             warnings/void MULTI:warnings/void/FATAL
166             warnings/imprecision MULTI:warnings/imprecision/FATAL
167             warnings/illegalproto MULTI:warnings/illegalproto/FATAL
168             warnings/non_unicode MULTI:warnings/non_unicode/FATAL
169             warnings/nonchar MULTI:warnings/nonchar/FATAL
170             warnings/surrogate MULTI:warnings/surrogate/FATAL
171             MULTI:warnings/experimental MULTI:warnings/experimental/FATAL
172             warnings/experimental::lexical_subs MULTI:warnings/experimental::lexical_subs/FATAL
173             warnings/experimental::lexical_topic MULTI:warnings/experimental::lexical_topic/FATAL
174             warnings/experimental::regex_sets MULTI:warnings/experimental::regex_sets/FATAL
175             warnings/experimental::smartmatch MULTI:warnings/experimental::smartmatch/FATAL
176             warnings/experimental::autoderef MULTI:warnings/experimental::autoderef/FATAL
177             warnings/experimental::postderef MULTI:warnings/experimental::postderef/FATAL
178             warnings/experimental::signatures MULTI:warnings/experimental::signatures/FATAL
179             warnings/syscalls MULTI:warnings/syscalls/FATAL
180             XXX:warnings/60 XXX:warnings/60/FATAL
181             XXX:warnings/61 XXX:warnings/61/FATAL
182             XXX:warnings/62 XXX:warnings/62/FATAL
183             XXX:warnings/63 XXX:warnings/63/FATAL
184             ),
185              
186             # feature (Bits 161-176)
187             qw(
188             feature/^V
189             feature/switch
190             feature/say
191             feature/state
192             MULTI:feature/unicode
193             feature/fc
194             feature/evalbytes
195             feature/array_base
196             feature/current_sub
197             feature/lexical_subs
198             feature/unicode_eval
199             feature/signatures
200             feature/postderef
201             feature/postderef_qq
202             feature/current_sub
203             XXX:feature/15
204             ),
205              
206             ### TODO: Might need move this set to the bottom and add some extra bitmap bits after Perl 5.23
207              
208             # Perl versions (Bits 177-184)
209             # (MAJOR-8)*16 + MINOR + 1 = 8-bit bitmap
210             qw(
211             BITMAP:perl/0
212             BITMAP:perl/1
213             BITMAP:perl/2
214             BITMAP:perl/3
215             BITMAP:perl/4
216             BITMAP:perl/5
217             BITMAP:perl/6
218             BITMAP:perl/7
219             ),
220              
221             # Autodie (Bits 185-200)
222             # Will expand if requested, but I don't want to waste
223             # all of that bit space right now.
224             qw(
225             MULTI:autodie/io
226             autodie/dbm
227             autodie/file
228             autodie/filesys
229             MULTI:autodie/ipc
230             autodie/msg
231             autodie/semaphore
232             autodie/shm
233             autodie/socket
234             autodie/threads
235             autodie/system
236             XXX:autodie/11
237             XXX:autodie/12
238             XXX:autodie/13
239             XXX:autodie/14
240             XXX:autodie/15
241             ),
242              
243             # Other CORE pragmas (Bits 201-216)
244             qw(
245             bigint
246             bignum
247             bigrat
248             charnames
249             charnames/short
250             charnames/full
251             encoding::warnings
252             encoding::warnings/FATAL
253             mro/dfs
254             mro/c3
255             open/crlf
256             open/bytes
257             open/utf8
258             open/locale
259             open/std
260             XXX:CORE/15
261             ),
262              
263             # Other pragmas (Bits 217-247 and beyond)
264             qw(
265             NO:autovivification/fetch
266             NO:autovivification/exists
267             NO:autovivification/delete
268             NO:autovivification/store
269             NO:autovivification/warn
270             NO:autovivification/strict
271             NO:indirect
272             NO:indirect/global
273             NO:indirect/fatal
274             NO:multidimensional
275             NO:bareword::filehandles
276             namespace::clean
277             namespace::autoclean
278             namespace::sweep
279             namespace::functions
280             subs::auto
281             utf8::all
282             IO::File
283             IO::Handle
284             IO::All
285             Carp
286             BITMAP:criticism/0
287             BITMAP:criticism/1
288             BITMAP:criticism/2
289             vendorlib
290             true
291             autolocale
292             perl5i::0
293             perl5i::1
294             perl5i::2
295             perl5i::3
296             perl5i::latest
297             Toolkit
298             ),
299             # new adds
300             qw(
301             Function::Parameters
302             Function::Parameters/strict
303             Switch::Plain
304             Quote::Code
305             ),
306             );
307             my %FLAGS; # namespace abuse I know...
308             $FLAGS{$FLAGS[$_]} = $_ for (0 .. $#FLAGS);
309              
310             my %ALIAS = (
311             strict => [qw(strict/refs strict/subs strict/vars)],
312              
313             # See corpus/warnbits.pl for the bitwise math
314             'warnings/all' => '1902996923607946508077714625932660180412006400', # 0x55555555555555555555555555555500
315             'warnings/all/FATAL' => '5708990770823839524233143877797980541236019200', # 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00
316             'warnings/io' => '1427247692705959881058285969473512868379885568', # 0x00545500000000000000000000004000
317             'warnings/io/FATAL' => '4281743078117879643174857908420538605139656704', # 0x00FCFF0000000000000000000000C000
318             'warnings/severe' => '6441307882634196071481344', # 0x00000000005405000000000000000000
319             'warnings/severe/FATAL' => '19323923647902588214444032', # 0x0000000000FC0F000000000000000000
320             'warnings/syntax' => '85071024421536332098205581043061227520', # 0x00000000000000555515004000000000
321             'warnings/syntax/FATAL' => '170142481534374380428773091271241629696', # 0x00000000000000FFFF3F008000000000
322             'warnings/utf8' => '7147258933335492648603770563127412785152', # 0x00000000000000000000000115000000
323             'warnings/utf8/FATAL' => '21441776800006477945811311689382238355456', # 0x0000000000000000000000033F000000
324             'warnings/experimental' => '475741971544825646998874771158206501072404480', # 0x00000000000000000000000040551500
325             'warnings/experimental/FATAL' => '1427225914634476940996624313474619503217213440', # 0x000000000000000000000000C0FF3F00
326             'warnings' => 'warnings/all',
327             'warnings/FATAL' => 'warnings/all/FATAL',
328              
329             # XXX: 5.18 has array_base and they "backported" it to older versions.
330             # We don't use it, but that's not totally accurate of the feature_bundles.
331             # It's a barely used $[ variable, anyway...
332              
333             'feature/unicode' => [qw(MULTI:feature/unicode feature/HINT/unicode)],
334             'feature/unicode_strings' => 'feature/unicode',
335             'feature/5.9.5' => 'feature/5.10',
336             'feature/5.10' => [map { "feature/$_" } qw(say state switch)], # 5.18 has array_base, but not in 5.10's version
337             'feature/5.11' => [map { "feature/$_" } qw(5.10 unicode)],
338             'feature/5.12' => 'feature/5.11',
339             'feature/5.13' => 'feature/5.11',
340             'feature/5.14' => 'feature/5.11',
341             'feature/5.15' => [map { "feature/$_" } qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
342             'feature/5.16' => 'feature/5.15',
343             'feature/5.17' => 'feature/5.15',
344             'feature/5.18' => 'feature/5.15',
345             'feature/5.19' => 'feature/5.15',
346             'feature/5.20' => 'feature/5.15',
347             'feature/5.21' => 'feature/5.15',
348             feature => 'feature/^V',
349              
350             'autodie/ipc' => [qw(MULTI:autodie/ipc autodie/msg autodie/semaphore autodie/shm)],
351             'autodie/io' => [qw(MULTI:autodie/io autodie/dbm autodie/file autodie/filesys autodie/ipc autodie/socket)],
352             'autodie/default' => [qw(autodie/io autodie/threads)],
353             'autodie/all' => [qw(autodie/default autodie/system)],
354             autodie => 'autodie/default',
355              
356             mro => 'mro/dfs',
357             'NO:autovivification' => [map { 'NO:autovivification/'.$_ } qw(fetch exists delete)],
358              
359             'criticism/gentle' => [map { 'BITMAP:criticism/'.$_ } qw(0 2)],
360             'criticism/stern' => 'BITMAP:criticism/2',
361             'criticism/harsh' => [map { 'BITMAP:criticism/'.$_ } qw(0 1)],
362             'criticism/cruel' => 'BITMAP:criticism/1',
363             'criticism/brutal' => 'BITMAP:criticism/0',
364             criticism => 'criticism/gentle',
365              
366             # mimicry of other "meta pragma" modules
367             'ex::caution' => [qw(strict warnings)],
368             'NO:crap' => [qw(strict warnings)],
369             'shit' => [qw(strict warnings)],
370             'latest' => [qw(strict warnings feature)],
371             'sane' => [qw(strict warnings feature utf8)],
372             'NO:nonsense' => [qw(strict warnings true namespace::autoclean)],
373             'Modern::Perl' => [qw(strict warnings mro/dfs feature IO::File IO::Handle)],
374             'strictures' => [qw(v5.8.4 strict warnings/all/FATAL NO:indirect/fatal NO:multidimensional NO:bareword::filehandles)],
375             'uni::perl' => [qw(
376             v5.10 strict feature/5.10
377             ), (
378             map { "warnings/$_/FATAL" } qw(closed threads internal debugging pack substr malloc
379             unopened portable prototype inplace io pipe unpack regexp deprecated exiting glob
380             digit printf utf8 layer reserved parenthesis taint closure semicolon)
381             ), qw(
382             -warnings/exec/FATAL
383             -warnings/newline/FATAL
384             utf8
385             open/utf8
386             open/std
387             mro/c3
388             Carp
389             )],
390             'common::sense' => [qw(
391             strict feature/5.10
392             ), (
393             map { "warnings/$_/FATAL" } qw(closed threads internal debugging pack malloc
394             portable prototype inplace io pipe unpack deprecated glob digit printf
395             layer reserved taint closure semicolon)
396             ),
397             qw(
398             -warnings/exec/FATAL
399             -warnings/newline/FATAL
400             -warnings/unopened/FATAL
401             utf8
402             )],
403             'sanity' => [qw(
404             v5.10.1 utf8 open/utf8 open/std mro/c3 strict/subs strict/vars feature/5.10
405             warnings/all/FATAL -warnings/uninitialized/FATAL -warnings/experimental::smartmatch/FATAL
406             NO:autovivification NO:autovivification/store NO:autovivification/strict
407             NO:indirect/fatal NO:multidimensional
408             )],
409             'Acme::Very::Modern::Perl' => [qw(Modern::Perl -mro/dfs mro/c3 utf8 open/utf8 open/std common::sense perl5i::latest Toolkit Carp)],
410             );
411              
412             # Implement experimental ALIASes in a similar manner as Leon's code itself
413             foreach my $main_pragma (qw[ array_base autoderef lexical_topic postderef regex_sets signatures smartmatch switch ]) {
414             # additional pragmas to enable
415             my @pragmas = ($main_pragma);
416             push @pragmas, 'postderef_qq' if $main_pragma eq 'postderef';
417             push @pragmas, 'smartmatch' if $main_pragma eq 'switch';
418              
419             my @flags;
420             foreach my $pragma (@pragmas) {
421             push @flags, "-warnings/experimental::$pragma" if "warnings/experimental::$pragma" ~~ @FLAGS;
422             push @flags, "feature/$pragma" if "feature/$pragma" ~~ @FLAGS;
423             }
424              
425             $ALIAS{"experimental/$main_pragma"} = \@flags;
426             }
427              
428             # All FATAL warnings have both bits marked (at least in $^{WARNING_BITS}),
429             # so we'll mimic the same
430             foreach my $flag ( grep { qr(^warnings/) } @FLAGS ) {
431             $ALIAS{"$flag/FATAL"} = [$flag, "MULTI:$flag/FATAL"];
432             }
433              
434             # These modules are optional. Everything else changes the nature
435             # of how Perl works, or would let you do something that would
436             # normally fatally error.
437             my @NON_INSTADIE = (qw(
438             overloading
439             autovivification
440             indirect
441             multidimensional
442             bareword::filehandles
443             criticism
444             ));
445             # (autovivification probably shouldn't be here, since it actually
446             # prevents autoviv, but it's generally used as an author tool.)
447              
448             my $author_load_warned;
449             sub import {
450 12     12   12140 my ($class, @args) = @_;
451              
452             # See if we need to encode a pragma hash
453 12         111 my $print_hash = find_and_remove(qr/^PRINT_PRAGMA_HASH$/, \@args);
454             # ... or print flags
455 12         76 my $print_flags = find_and_remove(qr/^PRINT_FLAGS$/, \@args);
456              
457 12 100       56 @args = ($class) unless (@args);
458 12 100   12   113 unshift @args, $class if (all { /^-/ } @args); # don't be all negative and such
  12         67  
459 12         63 @args = filter_args(@args);
460              
461 12 50       98 if ($print_hash) {
462 0         0 binmode STDOUT, ':utf8';
463 0         0 print "use $class '".encode_pragmahash(\@args, '0')."'; # Overly long decimal version\n";
464 0         0 print "use $class '".encode_pragmahash(\@args, '!')."'; # Safer ASCII version\n";
465 0         0 print "use $class '".encode_pragmahash(\@args, '¡')."'; # Shorter UTF8 version\n";
466             ### TODO: should try to resolve back to the closest alias ###
467 0         0 exit;
468             }
469 12 50       39 if ($print_flags) {
470 0         0 print join("\n", @args)."\n";
471 0         0 exit;
472             }
473              
474             # Look for every indicator that proves that the user is in the distro directory
475             # and appears to be one of the coders
476 12   33     79 my $author_mode = !!((caller)[1] =~ /^(?:x?t|b?lib)[\/\\]/ && (-d '.git' or -d '.svn'));
477 48 50       270 $author_mode = 0 if (grep {
478 12 50       632 $ENV{"PERL5_${_}_IS_RUNNING"} || $ENV{"PERL5_${_}_IS_RUNNING_IN_RECURSION"}
479             } (qw/CPANM CPANP CPANPLUS CPAN/) );
480              
481             # Process order:
482             # v5.##.##
483             # utf8
484             # mro
485             # strict
486             # warnings
487             # feature
488             # ...anything else...
489             # namespace::clean
490             # namespace::functions (always last)
491             # (If this needs to be changed, let me know and I can reorder it)
492              
493             # Perl version
494 12 100       97 if ( my @perl_version = find_and_remove(qr/^BITMAP:perl\b/, \@args) ) {
495 3         11 my $bitmap = args2bitmask(@perl_version) >> $FLAGS{'BITMAP:perl/0'};
496 3         1145 my $mj = ($bitmap >> 4) + 8;
497 3         519 my $mn = $bitmap % 16 - 1;
498              
499 1     1   140 eval "use v5.$mj.$mn";
  1     1   3  
  1     1   31  
  1         141  
  1         2  
  1         31  
  1         140  
  1         2  
  1         30  
  3         468  
500             }
501              
502 12         93 my @init = find_and_remove(qr/^(?:utf8|mro|strict|warnings|feature)\b/, \@args);
503 12         112 my @end = find_and_remove(qr/^namespace::(clean|functions)\b/, \@args);
504 12         136 my @mod_list = uniq map { (/^(?:[A-Z]+\:(?!\:))?([\w\:]+)/)[0] } (@init, sort(@args), @end);
  832         9547  
505 12         455 unshift @args, @init;
506 12         22 push @args, @end;
507              
508 12         19 my @failed;
509 12         29 foreach my $module (@mod_list) {
510 50         1439 my $success = load_pragma('import', find_and_remove(qr/^(?:[A-Z]+\:(?!\:))?$module\b/, \@args) );
511 50 100       593 unless (defined $success) {
512 3 50       24 require $module unless ($module ~~ @NON_INSTADIE); # death by suicide (which prints the proper error msg)
513 3         12 push @failed, $module;
514             }
515             }
516              
517 12 50 66     365 if (@failed and $author_mode and not $author_load_warned++) {
      33        
518 0         0 my $failed = join ' ', @failed;
519 0         0 warn <<EOE;
520             Detected current environment to be in "author mode" but couldn't load all
521             modules. Missing (author) modules were:
522              
523             $failed
524              
525             You should install these modules via CPAN, but these modules are not
526             required by your users (unless you add them to your META file).
527             EOE
528             }
529             }
530              
531             # This is import with some subtractions and slight changes
532             sub unimport {
533 0     0   0 my ($class, @args) = @_;
534              
535 0 0       0 @args = ($class) unless (@args);
536 0 0   0   0 unshift @args, $class if (all { /^-/ } @args); # don't be all negative and such
  0         0  
537 0         0 @args = filter_args(@args);
538              
539             # Process order: IN REVERSE!
540 0         0 my @end = find_and_remove(qr/^(?:utf8|mro|strict|warnings|feature)\b/, \@args);
541 0         0 my @init = find_and_remove(qr/^namespace::(clean|functions)\b/, \@args);
542 0         0 my @mod_list = uniq map { (/^(?:[A-Z]+\:(?!\:))?([\w\:]+)/)[0] } (@init, sort(@args), @end);
  0         0  
543 0         0 unshift @args, @init;
544 0         0 push @args, @end;
545              
546 0         0 foreach my $module (@mod_list) {
547 0         0 my $success = load_pragma('unimport', find_and_remove(qr/^(?:[A-Z]+\:(?!\:))?$module\b/, \@args) );
548 0 0 0     0 require $module unless (defined $success || $module !~~ @NON_INSTADIE); # death by suicide (which prints the proper error msg)
549             }
550             }
551              
552             sub load_pragma {
553 50     50 0 103 my $method = shift;
554 50 50       289 $method = 'import' unless ($method =~ /^(?:un)?import$/);
555 50 50       159 return 0 unless (@_);
556              
557             # import/unimport called us, so one step back
558 50         142 my $target = scalar caller(1);
559              
560 50         701 my ($module, @options);
561 50         115 foreach my $flag (@_) {
562 832         3767 ($module, my $param) = ($flag =~ qr!^([\w\:]+)(?:/(.+))?!);
563 832 100       1987 push @options, $param if ($param);
564             }
565              
566             # handle NO:
567 50         191 my ($modifier) = ($module =~ s/^([A-Z]+)\:(?!\:)//);
568 50 50       163 $method = 'un'.$method if ($modifier eq 'NO');
569 50         85 $method =~ s/^unun//;
570              
571             # Use import::into / unimport:out_of
572 50 50       198 $method .= '::'.($method =~ /^un/ ? 'out_of' : 'into');
573              
574 50 50       152 die "Cannot use XXX flag: XXX:$module" if ($modifier eq 'XXX');
575              
576             # Specific exceptions
577              
578             # (:param format for certain modules)
579 50 100       242 @options = map { ":$_" } @options if ($module =~ /^(?:open|indirect|charnames|autodie|Function::Parameters)$/);
  9         32  
580             # ^V = $^V (like feature)
581 50 100       99 @options = map { $_ = ($_ eq '^V') ? $VER_PACK : $_ } @options;
  823         1341  
582             # remove feature/HINT/unicode
583 50 100       176 @options = grep { !/^HINT\/unicode$/ } @options if ($module eq 'feature');
  16         34  
584             # (adding cleanee to namespace::* modules)
585 50 50 33     323 if ($module =~ /^namespace::/ and not $module eq 'namespace::functions') {
586 0         0 @options = (-cleanee => $target);
587             # (add 'meta' to namespace::clean's exceptions)
588 0 0       0 push @options, (-except => 'meta') if ($module eq 'namespace::clean');
589             }
590             # (handling of FATAL in warnings)
591 50 100       109 if ($module eq 'warnings') {
592             # separate out FATAL and non-FATAL options
593 10         89 my $options = [@options];
594 10         56 my @fatal = map { s|/FATAL$||; $_ } find_and_remove(qr|/FATAL$|, $options);
  196         280  
  196         330  
595 10         64 my @nonfatal = notin(\@fatal, $options);
596              
597             # To prevent "Unknown warnings category" errors for various versions of Perl,
598             # we'll need to remove the ones that don't exist in the current version.
599              
600             # (also remove the combo flags while we're at it...)
601 10         51 my @combos = grep { /^MULTI:warnings\/\w+$/ } @FLAGS;
  2530         3092  
602 10         64 @combos = map { s|MULTI:warnings/||; $_ } @combos;
  60         98  
  60         96  
603              
604 10         288 my @warn_categories = keys %warnings::Offsets;
605 10         65 @fatal = notin(\@combos, [ foundin(\@warn_categories, \@fatal) ]);
606 10         55 @nonfatal = notin(\@combos, [ foundin(\@warn_categories, \@nonfatal) ]);
607              
608             # if this is an import, first clean all warnings
609 10         132 warnings->unimport::out_of($target);
610              
611             # warnings can handle both in one import, so let's do it that way
612 10         2360 @options = ();
613 10 100       56 push(@options, FATAL => @fatal) if (@fatal);
614 10 100       185 push(@options, NONFATAL => @nonfatal) if (@nonfatal);
615             }
616 50 100       122 if ($module eq 'strict') {
617             # if this is an import, first clean all stricts
618 10         66 strict->unimport::out_of($target);
619             }
620             # (BITMAPs)
621 50 50       2159 if ($modifier eq 'BITMAP') {
622 0         0 my $bitmap = args2bitmask(map { s|^|BITMAP:$module/| } @options) >> $FLAGS{"BITMAP:$module/0"};
  0         0  
623 0 0       0 if ($module eq 'criticism') { @options = ( -severity => $bitmap ); }
  0 0       0  
624 0         0 elsif ($module eq 'perl') { die "Internal error (report as a bug): Perl versions should have already been extracted at this point!"; }
625 0         0 else { die "Unsupported set of BITMAP flags: BITMAP:$module/*"; }
626             }
627              
628             # open gets kinda strange with the eval/require
629 50         91 my $evalmodule = $module;
630 50 100       97 $evalmodule = "'open.pm'" if ($module eq 'open');
631              
632             # DO IT!
633 50 100       2340 if (eval "require $evalmodule; 1") {
634 47         1651 $module->$method($target, @options);
635 47         9259 return 1;
636             }
637 3         42 return undef;
638             }
639              
640             sub find_and_remove {
641 120     120 0 206 my ($re, $arr) = @_;
642 120 100       357 return (wantarray ? () : undef) unless @$arr;
    100          
643 116 50       368 $re = qr/$re/ unless (ref $re eq 'Regexp');
644              
645 116         135 my @flags;
646 116         473 for (my $i = 0; $i < @$arr; $i++) {
647 4930 100       657120 push @flags, splice(@$arr, $i--, 1) if ($arr->[$i] =~ $re);
648             }
649              
650 116         17424 return @flags;
651             }
652              
653             # Find items in @B that are in @A
654             sub foundin (\@\@) {
655 20     20 0 27 my ($A, $B) = @_;
656 20     17821   42 return grep { my $i = $_; any { $i eq $_ } @$A; } @$B;
  556         493  
  556         1374  
  17821         13098  
657             }
658              
659             # Find items in @B that are not in @A
660             sub notin (\@\@) {
661 30     30 0 48 my ($A, $B) = @_;
662 30     8583   69 return grep { my $i = $_; none { $i eq $_ } @$A; } @$B;
  1112         967  
  1112         2628  
  8583         6478  
663             }
664              
665             sub filter_args {
666 12     12 0 40 return bitmask2flags( args2bitmask(@_) );
667             }
668              
669             sub args2bitmask {
670 15     15 0 42 my @args = @_;
671              
672 15         26 my $bitmask = 0;
673 15         59 while (my $flag = shift @args) {
674 238         845000 my $negate_bit = ($flag =~ s/^-//);
675 238         425 my $bit = $FLAGS{$flag};
676 238         317 my $def = $ALIAS{$flag};
677              
678             # Direct find on FLAGS
679 238 100       931 if (defined $bit) {
    100          
    50          
    50          
    100          
    50          
680 153 100       483 $bitmask = $negate_bit ?
681             $bitmask & ~(1 << $bit) :
682             $bitmask | 1 << $bit;
683             }
684             # Perl version
685             elsif ($flag =~ /^(?| # branch reset (look it up)
686             v? 5\. (?<major>\d+) (?:\.(?<minor>\d+))? |
687             \x05(?<major>.)(?<minor>.)?
688             )$/x) {
689 1     1   65107 my ($mj, $mn) = ($+{major}, $+{minor});
  1         395  
  1         53  
  3         40  
690 3 50       13 ($mj, $mn) = (ord($mj), ord($mn)) if $flag =~ /^\x05/;
691 3   50     9 $mn ||= 0; # bigint/BigInt has weird problems with undef
692              
693 3         13 my $bitmask8 = ($mj-8) * 16 + $mn + 1;
694 3 50       1176 die "Perl version flags for sanity must be at least 5.8.0" if ($bitmask8 <= 0);
695              
696 3         83 foreach my $bit8 (0..7) {
697 24 100       5138 push @args, 'BITMAP:perl/'.$bit8 if ($bitmask8 & 1 << $bit8);
698             }
699             }
700             # Pragma hash
701             elsif ($flag =~ /^[!¡]/) {
702 0 0       0 die "Only one argument can be provided if you are using a pragma hash!" unless (@_ == 1);
703 0         0 return decode_pragmahash($flag);
704             }
705             # A UTF-8 pragma hash
706             elsif ($flag =~ /^\xC2\xA1/) {
707             # This could happen if the user sent in a UTF-8 string without saying 'use utf8;' or
708             # any identifying BOFs, etc., saying that the program is in UTF-8. Of course, the
709             # catch-22 is that they are expecting _sanity_ to enable utf8 for them, so we need to
710             # convert the string manually.
711 0         0 require Encode;
712 0         0 push @args, Encode::decode('utf8', $flag);
713             }
714             # A real bitmask
715             elsif ($flag =~ /^\d+$/) {
716 10         40 $flag += 0;
717 10 50       1368 $bitmask = $negate_bit ?
718             $bitmask & ~$flag :
719             $bitmask | $flag;
720             }
721             # An alias
722             elsif (defined $def) {
723 72 100       170 unshift @args, map { $negate_bit ? "-$_" : $_ } (ref $def ? @$def : $def);
  212 100       589  
724             }
725             else {
726 0         0 die "Unsupported flag: $flag";
727             }
728             }
729              
730 15         10536 return $bitmask;
731             }
732              
733             sub bitmask2flags {
734 12     12 0 22 my ($bitmask) = @_;
735              
736 12         23 my @flags;
737 12         48 foreach my $bit (0..@FLAGS-1) {
738 3036 100       1942191 push @flags, $FLAGS[$bit] if ($bitmask & 1 << $bit);
739             }
740              
741 12         11765 return @flags;
742             }
743              
744             my $CURRENT_HASH_VERSION = 0;
745              
746             sub encode_pragmahash {
747 0     0 0   my ($flags, $type) = @_;
748 0   0       $type //= '¡';
749              
750 0 0         $flags = args2bitmask(@$flags) if (ref $flags eq 'ARRAY');
751 0 0         return $flags if ($type eq '0');
752 0 0         my $hash = ($type eq '!' ? $calc90 : $calc48900)->to_base($flags);
753 0           return $type.$CURRENT_HASH_VERSION.$hash
754             }
755              
756             ### FIXME: Wait for Math::BaseCalc fix (RT #77198) ###
757             sub decode_pragmahash {
758 0     0 0   my ($hash) = @_;
759 0           ($hash, my $type) = (substr($hash, 1), substr($hash, 0, 1));
760 0 0         die "Invalid hash type ($type) for pragma hash: $hash" unless ($type =~ /^[!¡]$/);
761 0 0         die "Unsupported pragma hash version!" unless ($hash =~ s/^$CURRENT_HASH_VERSION//);
762              
763 0 0         return ($type eq '!' ? $calc90 : $calc48900)->from_base($hash);
764             }
765              
766             # warnings void + bigint + 1; + perl sanity.pm = "Useless use of a constant (1) in void context"
767             42;
768              
769             __END__
770              
771             =pod
772              
773             =encoding UTF-8
774              
775             =head1 NAME
776              
777             sanity - The ONLY meta pragma you'll ever need!
778              
779             =head1 SYNOPSIS
780              
781             use sanity;
782             use sanity 'strictures';
783             use sanity 'Modern::Perl';
784              
785             use sanity qw(
786             strictures -warnings/uninitialized/FATAL
787             NO:autovivification NO:autovivification/store
788             PRINT_PRAGMA_HASH
789             );
790             use sanity '!0*b^Npow{8T7_yZt<?cT6/?ZCO=Y0LV_Duoc'; # Safer ASCII version
791             use sanity '¡0Dz鵆㤧뱞⡫瘑빸ን둈댬嚝⠨舁聼䮋'; # Shorter UTF8 version
792              
793             =head1 DESCRIPTION
794              
795             Modern::Perl? common::sense? no nonsense? use latest?
796              
797             Everybody has their own opinion on what pragmas and modules are "required"
798             for every person to use. These opinions turn into "personal pragmas", so that
799             people don't have to type several C<use> lines of header in front of every module
800             they write.
801              
802             Personal opinions and pragmas don't really belong in the CPAN namespace. (It's
803             CPAN, not Personal PAN. If you want a Personal PAN, go call Pizza Hut.) But
804             copying code on potentially hundreds of modules doesn't make sense, either.
805              
806             That was my mentality when I had a personal opinion of my own. Why repeat the same
807             problem like everybody else?
808              
809             This "sanity" module attempts to level the playing field by making it a
810             B<customizable> personal pragma, allowing you to both reduce the code needed and
811             still implement all of the modules/pragmas you need.
812              
813             As an illustration to what it's capable of, this pragma will emulate all of the
814             other personal pragmas, most of them 100% working exactly how they do it.
815              
816             =head1 PARAMETERS
817              
818             Sanity's parameters fall into three types: flags, aliases, and hashes. (Oh my!)
819              
820             =head2 Flags and Aliases
821              
822             Flags are single pragma/module declarations, strict/warning flags, or other
823             items that need flags. Aliases are merely one or more flags, grouped
824             together to better emulate the pragma/module's functionality.
825              
826             Let's start off with an example:
827              
828             # These three statements do the same thing as...
829             use Modern::Perl;
830             use sanity 'Modern::Perl';
831             use sanity qw(strict warnings mro/dfs feature IO::File IO::Handle);
832              
833             # ...these statements
834             use strict;
835             use warnings;
836             use mro 'dfs';
837             use feature ':all';
838             use IO::File;
839             use IO::Handle;
840              
841             Basically, it does the same thing as the meta pragma L<Modern::Perl>, except
842             you actually don't need that module for it to work. While there is some magic
843             to make sure, say, C<feature> gets loaded with various versions of Perl, it typically
844             just works using a standard C<import> call. The C<strict> and C<warnings> flags
845             are combined aliases that enable all of the warnings that they would do via a standard
846             call.
847              
848             =head3 Negating flags/aliases
849              
850             You can turn off flags in the statement:
851              
852             use sanity qw(Modern::Perl -mro/dfs);
853              
854             This does the same thing as above, except it doesn't import the C<mro> pragma. You
855             can negate any flag, including combined aliases, as long as it makes sense. In other
856             words, you need a positive included before you can negate something.
857              
858             =head3 NO:* flags/aliases
859              
860             Some pragmas work by using the C<B<unimport>> function, so that the English makes sense.
861             To keep that syntax, these pragmas are included with a C<NO:> prefix:
862              
863             use sanity 'NO:multidimensional';
864             use sanity 'NO:indirect/FATAL';
865              
866             This will run the C<unimport> function on these pragmas, even though sanity was called
867             via the C<import> function (via C<use>).
868              
869             =head3 Perl versions
870              
871             Sanity also supports Perl versions as a special kind of alias to specify minimum Perl
872             versions:
873              
874             # These are all the same:
875             use v5.10.1;
876             use sanity 'v5.10.1';
877             use sanity v5.10.1; # as a VSTRING
878             use sanity 5.10.1; # works too
879              
880             # Upgrade the Perl version of your favorite pragma
881             use sanity qw(NO:nonsense v5.12);
882              
883             Note that the version must be at least v5.8. This should be fine for most people. (If
884             I get a ticket requesting support for a Perl version older than one released in 2002, I
885             will hunt you down and break your keyboard in half.)
886              
887             =head3 The Default
888              
889             What does C<sanity> do without any parameters? Why my personal preference, of course :)
890             It's listed in the C<meta pragma> section of the L<LIST OF FLAGS> below. I detail the
891             reasons behind my choices L<here|sanity::sanity>.
892              
893             =head2 Hashes
894              
895             So, there's all of these flags, but unless you're using one of the combined aliases,
896             typing them all out is usually just as much (or more) code as the several lines of C<use>
897             statements. Well, they are all flags so that it fits into a giant bitmap, and that
898             bitmap can be compressed into a large ASCII (or UTF-8) "number".
899              
900             This number can be calculated using the flag C<PRINT_PRAGMA_HASH>:
901              
902             # This is merely the definition of uni::perl
903             use sanity (qw(
904             v5.10 strict feature/5.10
905             ), (
906             map { "warnings/$_/FATAL" } qw(closed threads internal debugging pack substr malloc
907             unopened portable prototype inplace io pipe unpack regexp deprecated exiting glob
908             digit printf utf8 layer reserved parenthesis taint closure semicolon)
909             ), qw(
910             -warnings/exec/FATAL
911             -warnings/newline/FATAL
912             utf8
913             open/utf8
914             open/std
915             mro/c3
916             Carp
917             ), 'PRINT_PRAGMA_HASH');
918              
919             # Outputs:
920             # use sanity '!04[D{9Fhfqc-7m738S4HK6B#D5=v{,T$(0)F5i'; # Safer ASCII version
921             # use sanity '¡05༕ቑ釩腜쥸봱楇䐍퇥熠ᾯ緻褻真堩'; # Shorter UTF8 version
922              
923             You can use that hash as the output illustrates without having to type out the entire big
924             set of commands or flags.
925              
926             =head2 Other Meta Pragmas
927              
928             Have your own set that is too long, and you don't like the ugliness of the hash? Send me
929             your suggestion and I'll probably add it in.
930              
931             =head1 CAVEATS
932              
933             =head2 'NO:' ne '-'
934              
935             A C<NO:> flag is NOT the same as negating a flag! You also cannot remove the C<NO:>
936             from a flag, as it's part of the name of the flag, not a special modifier.
937              
938             # These two are NOT the same!
939             use sanity 'NO:indirect'; # runs indirect->unimport()
940             use sanity '-indirect'; # Dies, as there is no such flag/alias
941              
942             # This runs through the strictures alias and runs autovivification->unimport()
943             use sanity qw(strictures NO:autovivification);
944              
945             # This runs through the strictures alias WITHOUT running indirect->unimport()
946             use sanity qw(strictures -NO:indirect);
947              
948             use sanity '-indirect'; # This isn't what you want...
949             no sanity 'NO:indirect'; # ...you really meant to do this...
950             use indirect; # ...but this is better
951              
952             =head2 Special clearing of strict/warnings
953              
954             Since most people want exactly the strictness and warnings they specify, sanity will
955             clear these out first before running through the list.
956              
957             # This...
958             use sanity qw(strict -strict/vars);
959              
960             # ...is the same as this...
961             no strict;
962             use strict qw(subs refs);
963              
964             Also, some special magic is in place to ensure that newer warnings/features aren't
965             fatal to older Perls. See L<https://rt.perl.org/rt3/Ticket/Display.html?id=112920>.
966              
967             =head2 "Author" pragmas
968              
969             Certain pragmas really only exist to make sure the code is designed right. These
970             pragmas are deemed "optional" by C<sanity>. In other words, if the user doesn't
971             have them, it will just silently ignore them and move on. If C<sanity> thinks you're
972             an author/coder of the module itself (.git/svn/$ENV checks), it will give you a
973             warning that they are missing, but move on.
974              
975             The following modules don't "instadie". Modules that fall under this list don't
976             change the nature of how Perl works, or would let you do something that would
977             normally fatally error.
978              
979             overloading
980             autovivification
981             indirect
982             multidimensional
983             bareword::filehandles
984             criticism
985              
986             # (autovivification probably shouldn't be here, since it actually
987             # prevents autoviv, but it's generally used as an author tool.)
988              
989             This feature was borrowed from L<strictures> and tweaked.
990              
991             =head1 LIST OF FLAGS
992              
993             =head2 Emulation of "meta pragmas"
994              
995             ex::caution:
996             strict
997             warnings
998             NO:crap: # Same as above
999             shit: # Same as above
1000             latest:
1001             strict
1002             warnings
1003             feature
1004             sane:
1005             strict
1006             warnings
1007             feature
1008             utf8
1009             NO:nonsense:
1010             strict
1011             warnings
1012             true
1013             namespace::autoclean
1014             Modern::Perl:
1015             strict
1016             warnings
1017             mro 'dfs'
1018             feature
1019             IO::File
1020             IO::Handle
1021             strictures: (without the 5.8.4 checks; that crap is old)
1022             v5.8.4 (forced, to make sure things work)
1023             strict
1024             warnings FATAL => 'all'
1025             no indirect 'fatal'
1026             no multidimensional
1027             no bareword::filehandles
1028             common::sense: (without the "memory usage" BS)
1029             utf8
1030             strict qw(subs vars)
1031             feature qw(say state switch)
1032             no warnings
1033             warnings FATAL => qw(closed threads internal debugging pack malloc portable prototype
1034             inplace io pipe unpack deprecated glob digit printf
1035             layer reserved taint closure semicolon)
1036             no warnings qw(exec newline unopened);
1037             uni::perl: (ditto)
1038             v5.10
1039             strict
1040             feature qw(say state switch)
1041             no warnings
1042             warnings qw(FATAL closed threads internal debugging pack substr malloc
1043             unopened portable prototype inplace io pipe unpack regexp
1044             deprecated exiting glob digit printf utf8 layer
1045             reserved parenthesis taint closure semicolon)
1046             no warnings qw(exec newline)
1047             utf8
1048             open (:utf8 :std)
1049             mro 'c3'
1050             Carp
1051             sanity:
1052             v5.10.1
1053             utf8
1054             open (:utf8 :std)
1055             mro 'c3'
1056             strict qw(subs vars)
1057             no strict 'refs'
1058             warnings FATAL => 'all'
1059             no warnings qw(uninitialized experimental::smartmatch)
1060             feature '5.10'
1061             no autovivification qw(fetch exists delete store strict)
1062             no indirect 'fatal'
1063             no multidimensional
1064             perl5i::0 / 1 / 2 / latest:
1065             [the real module] (the pragma is too insane to try to duplicate here)
1066             Acme::Very::Modern::Perl: (a joke, but it's still here all the same)
1067             strict
1068             warnings
1069             mro 'c3'
1070             feature
1071             IO::File
1072             IO::Handle
1073             utf8
1074             open (:utf8 :std)
1075             no warnings
1076             warnings FATAL => qw(closed threads internal debugging pack malloc portable prototype
1077             inplace io pipe unpack deprecated glob digit printf
1078             layer reserved taint closure semicolon)
1079             no warnings qw(exec newline unopened);
1080             perl5i::latest
1081             Toolkit
1082             Carp
1083              
1084             =head2 Other flags/aliases
1085              
1086             strict/* => strict '[whatever]' # supports all flags
1087             strict => strict qw(refs subs vars)
1088              
1089             # other "hints"
1090             integer
1091             locale
1092             bytes
1093             re/taint
1094             re/eval
1095             filetest
1096             utf8
1097             NO:overloading
1098              
1099             warnings/* => warnings NONFATAL => '[whatever]' # supports all flags, multi or not
1100             warnings/*/FATAL => warnings FATAL => '[whatever]' # supports all flags; FATAL trumps NONFATAL
1101             warnings => warnings NONFATAL => 'all'
1102             warnings/FATAL => warnings FATAL => 'all'
1103              
1104             feature/* => feature '[whatever]' # supports all flags
1105             feature/5.## => # similar to feature enabling via 'use v5.##'; major version only
1106             feature/5.9.5 => # also exists, just like feature/5.10
1107             feature => feature ':all' # not exactly, but in spirit
1108              
1109             # Perl versions, described above
1110             v5.##.##
1111              
1112             # autodie
1113             autodie/* => autodie ':[whatever]' # supports all _category_ flags, like all, io, shm, etc.
1114             # (Will expand if requested, but I don't want to waste
1115             # all of that bit space right now.)
1116             autodie => autodie ':default'
1117              
1118             # other CORE pragmas
1119             bigint
1120             bignum
1121             bigrat
1122             charnames
1123             charnames/short
1124             charnames/full
1125             encoding::warnings
1126             encoding::warnings/FATAL
1127             mro/dfs # default for 'mro'
1128             mro/c3
1129             open/*
1130              
1131             # namespace cleaners
1132             namespace::clean # included last; adds -except => 'meta'
1133             namespace::functions # included last
1134             namespace::autoclean
1135             namespace::sweep
1136              
1137             # others
1138             NO:autovivification/*
1139             NO:autovivification => no autovivification qw(fetch exists delete)
1140              
1141             criticism/*
1142             criticism => criticism 'gentle'
1143              
1144             experimental/*
1145              
1146             perl5i::0
1147             perl5i::1
1148             perl5i::2
1149             perl5i::3
1150             perl5i::latest
1151              
1152             NO:indirect
1153             NO:indirect/global
1154             NO:indirect/fatal
1155             NO:multidimensional
1156             NO:bareword::filehandles
1157              
1158             subs::auto
1159             utf8::all
1160             IO::File
1161             IO::Handle
1162             IO::All
1163             Carp
1164             vendorlib
1165             true
1166             autolocale
1167             Toolkit
1168              
1169             Function::Parameters
1170             Function::Parameters/strict
1171             Switch::Plain
1172             Quote::Code
1173              
1174             Am I missing something? Let me know.
1175              
1176             =head1 TODO
1177              
1178             Actually need to write sanity::sanity POD.
1179              
1180             =head1 AVAILABILITY
1181              
1182             The project homepage is L<https://github.com/SineSwiper/sanity>.
1183              
1184             The latest version of this module is available from the Comprehensive Perl
1185             Archive Network (CPAN). Visit L<http://www.perl.com/CPAN/> to find a CPAN
1186             site near you, or see L<https://metacpan.org/module/sanity/>.
1187              
1188             =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
1189              
1190             =head1 SUPPORT
1191              
1192             =head2 Internet Relay Chat
1193              
1194             You can get live help by using IRC ( Internet Relay Chat ). If you don't know what IRC is,
1195             please read this excellent guide: L<http://en.wikipedia.org/wiki/Internet_Relay_Chat>. Please
1196             be courteous and patient when talking to us, as we might be busy or sleeping! You can join
1197             those networks/channels and get help:
1198              
1199             =over 4
1200              
1201             =item *
1202              
1203             irc.perl.org
1204              
1205             You can connect to the server at 'irc.perl.org' and talk to this person for help: SineSwiper.
1206              
1207             =back
1208              
1209             =head2 Bugs / Feature Requests
1210              
1211             Please report any bugs or feature requests via L<https://github.com/SineSwiper/sanity/issues>.
1212              
1213             =head1 AUTHOR
1214              
1215             Brendan Byrd <BBYRD@CPAN.org>
1216              
1217             =head1 CONTRIBUTOR
1218              
1219             =for stopwords Graham Knop
1220              
1221             Graham Knop <haarg@haarg.org>
1222              
1223             =head1 COPYRIGHT AND LICENSE
1224              
1225             This software is Copyright (c) 2014 by Brendan Byrd.
1226              
1227             This is free software, licensed under:
1228              
1229             The Artistic License 2.0 (GPL Compatible)
1230              
1231             =cut