File Coverage

blib/lib/sanity.pm
Criterion Covered Total %
statement 160 210 76.1
branch 66 116 56.9
condition 5 19 26.3
subroutine 26 30 86.6
pod 0 9 0.0
total 257 384 66.9


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