| 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 |