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 |