Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | package strict; |
2 | ||
b4aeee75 | 3 | $strict::VERSION = "1.12"; |
e3def60f | 4 | |
ed958fa3 JR |
5 | my ( %bitmask, %explicit_bitmask ); |
6 | ||
7 | BEGIN { | |
67ba812d AP |
8 | # Verify that we're called correctly so that strictures will work. |
9 | # Can't use Carp, since Carp uses us! | |
10 | # see also warnings.pm. | |
11 | die sprintf "Incorrect use of pragma '%s' at %s line %d.\n", __PACKAGE__, +(caller)[1,2] | |
12 | if __FILE__ !~ ( '(?x) \b '.__PACKAGE__.' \.pmc? \z' ) | |
13 | && __FILE__ =~ ( '(?x) \b (?i:'.__PACKAGE__.') \.pmc? \z' ); | |
14 | ||
ed958fa3 JR |
15 | %bitmask = ( |
16 | refs => 0x00000002, | |
17 | subs => 0x00000200, | |
18 | vars => 0x00000400, | |
19 | ); | |
20 | ||
21 | %explicit_bitmask = ( | |
22 | refs => 0x00000020, | |
23 | subs => 0x00000040, | |
24 | vars => 0x00000080, | |
25 | ); | |
26 | ||
27 | my $bits = 0; | |
28 | $bits |= $_ for values %bitmask; | |
29 | ||
30 | my $inline_all_bits = $bits; | |
31 | *all_bits = sub () { $inline_all_bits }; | |
32 | ||
33 | $bits = 0; | |
34 | $bits |= $_ for values %explicit_bitmask; | |
35 | ||
36 | my $inline_all_explicit_bits = $bits; | |
37 | *all_explicit_bits = sub () { $inline_all_explicit_bits }; | |
38 | } | |
4b2eca7a NC |
39 | |
40 | sub bits { | |
41 | my $bits = 0; | |
42 | my @wrong; | |
43 | foreach my $s (@_) { | |
ed958fa3 JR |
44 | if (exists $bitmask{$s}) { |
45 | $^H |= $explicit_bitmask{$s}; | |
46 | ||
47 | $bits |= $bitmask{$s}; | |
48 | } | |
49 | else { | |
50 | push @wrong, $s; | |
51 | } | |
4b2eca7a NC |
52 | } |
53 | if (@wrong) { | |
4b2eca7a | 54 | require Carp; |
e279cb0b | 55 | Carp::croak("Unknown 'strict' tag(s) '@wrong'"); |
4b2eca7a NC |
56 | } |
57 | $bits; | |
58 | } | |
59 | ||
60 | sub import { | |
61 | shift; | |
ed958fa3 | 62 | $^H |= @_ ? &bits : all_bits | all_explicit_bits; |
4b2eca7a NC |
63 | } |
64 | ||
65 | sub unimport { | |
66 | shift; | |
ed958fa3 JR |
67 | |
68 | if (@_) { | |
69 | $^H &= ~&bits; | |
70 | } | |
71 | else { | |
72 | $^H &= ~all_bits; | |
73 | $^H |= all_explicit_bits; | |
74 | } | |
4b2eca7a NC |
75 | } |
76 | ||
77 | 1; | |
78 | __END__ | |
79 | ||
f06db76b AD |
80 | =head1 NAME |
81 | ||
82 | strict - Perl pragma to restrict unsafe constructs | |
83 | ||
84 | =head1 SYNOPSIS | |
85 | ||
86 | use strict; | |
87 | ||
88 | use strict "vars"; | |
89 | use strict "refs"; | |
90 | use strict "subs"; | |
91 | ||
92 | use strict; | |
93 | no strict "vars"; | |
94 | ||
95 | =head1 DESCRIPTION | |
96 | ||
55fe01c5 DB |
97 | The C<strict> pragma disables certain Perl expressions that could behave |
98 | unexpectedly or are difficult to debug, turning them into errors. The | |
99 | effect of this pragma is limited to the current file or scope block. | |
100 | ||
f06db76b AD |
101 | If no import list is supplied, all possible restrictions are assumed. |
102 | (This is the safest mode to operate in, but is sometimes too strict for | |
55497cff | 103 | casual programming.) Currently, there are three possible things to be |
104 | strict about: "subs", "vars", and "refs". | |
f06db76b AD |
105 | |
106 | =over 6 | |
107 | ||
108 | =item C<strict refs> | |
109 | ||
110 | This generates a runtime error if you | |
111 | use symbolic references (see L<perlref>). | |
112 | ||
113 | use strict 'refs'; | |
114 | $ref = \$foo; | |
115 | print $$ref; # ok | |
116 | $ref = "foo"; | |
117 | print $$ref; # runtime error; normally ok | |
d6fd2b02 GS |
118 | $file = "STDOUT"; |
119 | print $file "Hi!"; # error; note: no comma after $file | |
f06db76b | 120 | |
cec39fc8 RS |
121 | There is one exception to this rule: |
122 | ||
123 | $bar = \&{'foo'}; | |
124 | &$bar; | |
125 | ||
126 | is allowed so that C<goto &$AUTOLOAD> would not break under stricture. | |
127 | ||
128 | ||
f06db76b AD |
129 | =item C<strict vars> |
130 | ||
657c2f9b AC |
131 | This generates a compile-time error if you access a variable that was |
132 | neither explicitly declared (using any of C<my>, C<our>, C<state>, or C<use | |
133 | vars>) nor fully qualified. (Because this is to avoid variable suicide | |
134 | problems and subtle dynamic scoping issues, a merely C<local> variable isn't | |
135 | good enough.) See L<perlfunc/my>, L<perlfunc/our>, L<perlfunc/state>, | |
136 | L<perlfunc/local>, and L<vars>. | |
f06db76b AD |
137 | |
138 | use strict 'vars'; | |
139 | $X::foo = 1; # ok, fully qualified | |
140 | my $foo = 10; # ok, my() var | |
97631e60 | 141 | local $baz = 9; # blows up, $baz not declared before |
f06db76b | 142 | |
535b5725 | 143 | package Cinna; |
17f410f9 | 144 | our $bar; # Declares $bar in current package |
535b5725 TP |
145 | $bar = 'HgS'; # ok, global declared via pragma |
146 | ||
f06db76b AD |
147 | The local() generated a compile-time error because you just touched a global |
148 | name without fully qualifying it. | |
149 | ||
3ce0d271 GS |
150 | Because of their special use by sort(), the variables $a and $b are |
151 | exempted from this check. | |
152 | ||
f06db76b AD |
153 | =item C<strict subs> |
154 | ||
cb1a09d0 AD |
155 | This disables the poetry optimization, generating a compile-time error if |
156 | you try to use a bareword identifier that's not a subroutine, unless it | |
b4aeee75 TC |
157 | is a simple identifier (no colons) and that it appears in curly braces, |
158 | on the left hand side of the C<< => >> symbol, or has the unary minus | |
159 | operator applied to it. | |
f06db76b AD |
160 | |
161 | use strict 'subs'; | |
555bd962 BG |
162 | $SIG{PIPE} = Plumber; # blows up |
163 | $SIG{PIPE} = "Plumber"; # fine: quoted string is always ok | |
164 | $SIG{PIPE} = \&Plumber; # preferred form | |
cb1a09d0 | 165 | |
f06db76b AD |
166 | =back |
167 | ||
ee580363 | 168 | See L<perlmodlib/Pragmatic Modules>. |
f06db76b | 169 | |
d66e832e RGS |
170 | =head1 HISTORY |
171 | ||
cbbb4974 | 172 | C<strict 'subs'>, with Perl 5.6.1, erroneously permitted to use an unquoted |
d66e832e RGS |
173 | compound identifier (e.g. C<Foo::Bar>) as a hash key (before C<< => >> or |
174 | inside curlies), but without forcing it always to a literal string. | |
175 | ||
cbbb4974 JH |
176 | Starting with Perl 5.8.1 strict is strict about its restrictions: |
177 | if unknown restrictions are used, the strict pragma will abort with | |
178 | ||
179 | Unknown 'strict' tag(s) '...' | |
180 | ||
e3def60f JV |
181 | As of version 1.04 (Perl 5.10), strict verifies that it is used as |
182 | "strict" to avoid the dreaded Strict trap on case insensitive file | |
183 | systems. | |
184 | ||
f06db76b | 185 | =cut |