1package strict; 2 3$strict::VERSION = "1.04"; 4 5# Verify that we're called correctly so that strictures will work. 6unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) { 7 # Can't use Carp, since Carp uses us! 8 my (undef, $f, $l) = caller; 9 die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n"); 10} 11 12my %bitmask = ( 13refs => 0x00000002, 14subs => 0x00000200, 15vars => 0x00000400 16); 17 18sub 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) { 26 require Carp; 27 Carp::croak("Unknown 'strict' tag(s) '@wrong'"); 28 } 29 $bits; 30} 31 32my $default_bits = bits(qw(refs subs vars)); 33 34sub import { 35 shift; 36 $^H |= @_ ? bits(@_) : $default_bits; 37} 38 39sub unimport { 40 shift; 41 $^H &= ~ (@_ ? bits(@_) : $default_bits); 42} 43 441; 45__END__ 46 47=head1 NAME 48 49strict - 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 64If 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 66casual programming.) Currently, there are three possible things to be 67strict about: "subs", "vars", and "refs". 68 69=over 6 70 71=item C<strict refs> 72 73This generates a runtime error if you 74use 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 81 $file = "STDOUT"; 82 print $file "Hi!"; # error; note: no comma after $file 83 84There is one exception to this rule: 85 86 $bar = \&{'foo'}; 87 &$bar; 88 89is allowed so that C<goto &$AUTOLOAD> would not break under stricture. 90 91 92=item C<strict vars> 93 94This generates a compile-time error if you access a variable that wasn't 95declared via C<our> or C<use vars>, 96localized via C<my()>, or wasn't fully qualified. Because this is to avoid 97variable suicide problems and subtle dynamic scoping issues, a merely 98local() variable isn't good enough. See L<perlfunc/my> and 99L<perlfunc/local>. 100 101 use strict 'vars'; 102 $X::foo = 1; # ok, fully qualified 103 my $foo = 10; # ok, my() var 104 local $foo = 9; # blows up 105 106 package Cinna; 107 our $bar; # Declares $bar in current package 108 $bar = 'HgS'; # ok, global declared via pragma 109 110The local() generated a compile-time error because you just touched a global 111name without fully qualifying it. 112 113Because of their special use by sort(), the variables $a and $b are 114exempted from this check. 115 116=item C<strict subs> 117 118This disables the poetry optimization, generating a compile-time error if 119you try to use a bareword identifier that's not a subroutine, unless it 120is a simple identifier (no colons) and that it appears in curly braces or 121on the left hand side of the C<< => >> symbol. 122 123 use strict 'subs'; 124 $SIG{PIPE} = Plumber; # blows up 125 $SIG{PIPE} = "Plumber"; # just fine: quoted string is always ok 126 $SIG{PIPE} = \&Plumber; # preferred form 127 128=back 129 130See L<perlmodlib/Pragmatic Modules>. 131 132=head1 HISTORY 133 134C<strict 'subs'>, with Perl 5.6.1, erroneously permitted to use an unquoted 135compound identifier (e.g. C<Foo::Bar>) as a hash key (before C<< => >> or 136inside curlies), but without forcing it always to a literal string. 137 138Starting with Perl 5.8.1 strict is strict about its restrictions: 139if unknown restrictions are used, the strict pragma will abort with 140 141 Unknown 'strict' tag(s) '...' 142 143As 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 145systems. 146 147=cut 148