Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | package strict; |
2 | ||
d9f099ba | 3 | $strict::VERSION = "1.05"; |
e3def60f JV |
4 | |
5 | # Verify that we're called correctly so that strictures will work. | |
5108dc18 | 6 | unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) { |
e3def60f JV |
7 | # Can't use Carp, since Carp uses us! |
8 | my (undef, $f, $l) = caller; | |
5108dc18 | 9 | die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n"); |
e3def60f | 10 | } |
4b2eca7a NC |
11 | |
12 | my %bitmask = ( | |
13 | refs => 0x00000002, | |
14 | subs => 0x00000200, | |
15 | vars => 0x00000400 | |
16 | ); | |
17 | ||
18 | sub bits { | |
19 | my $bits = 0; | |
20 | my @wrong; | |
21 | foreach my $s (@_) { | |
22 | push @wrong, $s unless exists $bitmask{$s}; | |
23 | $bits |= $bitmask{$s} || 0; | |
24 | } | |
25 | if (@wrong) { | |
4b2eca7a | 26 | require Carp; |
e279cb0b | 27 | Carp::croak("Unknown 'strict' tag(s) '@wrong'"); |
4b2eca7a NC |
28 | } |
29 | $bits; | |
30 | } | |
31 | ||
08d31bcd JH |
32 | my $default_bits = bits(qw(refs subs vars)); |
33 | ||
4b2eca7a NC |
34 | sub import { |
35 | shift; | |
08d31bcd | 36 | $^H |= @_ ? bits(@_) : $default_bits; |
4b2eca7a NC |
37 | } |
38 | ||
39 | sub unimport { | |
40 | shift; | |
08d31bcd | 41 | $^H &= ~ (@_ ? bits(@_) : $default_bits); |
4b2eca7a NC |
42 | } |
43 | ||
44 | 1; | |
45 | __END__ | |
46 | ||
f06db76b AD |
47 | =head1 NAME |
48 | ||
49 | strict - Perl pragma to restrict unsafe constructs | |
50 | ||
51 | =head1 SYNOPSIS | |
52 | ||
53 | use strict; | |
54 | ||
55 | use strict "vars"; | |
56 | use strict "refs"; | |
57 | use strict "subs"; | |
58 | ||
59 | use strict; | |
60 | no strict "vars"; | |
61 | ||
62 | =head1 DESCRIPTION | |
63 | ||
64 | If no import list is supplied, all possible restrictions are assumed. | |
65 | (This is the safest mode to operate in, but is sometimes too strict for | |
55497cff | 66 | casual programming.) Currently, there are three possible things to be |
67 | strict about: "subs", "vars", and "refs". | |
f06db76b AD |
68 | |
69 | =over 6 | |
70 | ||
71 | =item C<strict refs> | |
72 | ||
73 | This generates a runtime error if you | |
74 | use symbolic references (see L<perlref>). | |
75 | ||
76 | use strict 'refs'; | |
77 | $ref = \$foo; | |
78 | print $$ref; # ok | |
79 | $ref = "foo"; | |
80 | print $$ref; # runtime error; normally ok | |
d6fd2b02 GS |
81 | $file = "STDOUT"; |
82 | print $file "Hi!"; # error; note: no comma after $file | |
f06db76b | 83 | |
cec39fc8 RS |
84 | There is one exception to this rule: |
85 | ||
86 | $bar = \&{'foo'}; | |
87 | &$bar; | |
88 | ||
89 | is allowed so that C<goto &$AUTOLOAD> would not break under stricture. | |
90 | ||
91 | ||
f06db76b AD |
92 | =item C<strict vars> |
93 | ||
94 | This generates a compile-time error if you access a variable that wasn't | |
97631e60 ML |
95 | declared via C<our>, C<use vars>, or C<my()>, and wasn't fully qualified. |
96 | Because this is to avoid | |
f06db76b AD |
97 | variable suicide problems and subtle dynamic scoping issues, a merely |
98 | local() variable isn't good enough. See L<perlfunc/my> and | |
99 | L<perlfunc/local>. | |
100 | ||
101 | use strict 'vars'; | |
102 | $X::foo = 1; # ok, fully qualified | |
103 | my $foo = 10; # ok, my() var | |
97631e60 | 104 | local $baz = 9; # blows up, $baz not declared before |
f06db76b | 105 | |
535b5725 | 106 | package Cinna; |
17f410f9 | 107 | our $bar; # Declares $bar in current package |
535b5725 TP |
108 | $bar = 'HgS'; # ok, global declared via pragma |
109 | ||
f06db76b AD |
110 | The local() generated a compile-time error because you just touched a global |
111 | name without fully qualifying it. | |
112 | ||
3ce0d271 GS |
113 | Because of their special use by sort(), the variables $a and $b are |
114 | exempted from this check. | |
115 | ||
f06db76b AD |
116 | =item C<strict subs> |
117 | ||
cb1a09d0 AD |
118 | This disables the poetry optimization, generating a compile-time error if |
119 | you try to use a bareword identifier that's not a subroutine, unless it | |
d66e832e RGS |
120 | is a simple identifier (no colons) and that it appears in curly braces or |
121 | on the left hand side of the C<< => >> symbol. | |
f06db76b AD |
122 | |
123 | use strict 'subs'; | |
124 | $SIG{PIPE} = Plumber; # blows up | |
5438961c | 125 | $SIG{PIPE} = "Plumber"; # just fine: quoted string is always ok |
cb1a09d0 AD |
126 | $SIG{PIPE} = \&Plumber; # preferred form |
127 | ||
f06db76b AD |
128 | =back |
129 | ||
ee580363 | 130 | See L<perlmodlib/Pragmatic Modules>. |
f06db76b | 131 | |
d66e832e RGS |
132 | =head1 HISTORY |
133 | ||
cbbb4974 | 134 | C<strict 'subs'>, with Perl 5.6.1, erroneously permitted to use an unquoted |
d66e832e RGS |
135 | compound identifier (e.g. C<Foo::Bar>) as a hash key (before C<< => >> or |
136 | inside curlies), but without forcing it always to a literal string. | |
137 | ||
cbbb4974 JH |
138 | Starting with Perl 5.8.1 strict is strict about its restrictions: |
139 | if unknown restrictions are used, the strict pragma will abort with | |
140 | ||
141 | Unknown 'strict' tag(s) '...' | |
142 | ||
e3def60f JV |
143 | As of version 1.04 (Perl 5.10), strict verifies that it is used as |
144 | "strict" to avoid the dreaded Strict trap on case insensitive file | |
145 | systems. | |
146 | ||
f06db76b | 147 | =cut |