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