X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstrict.pm;h=d1479ed865ee1dd4c627f6d08ec90728f628c70c;hb=11412ee612ee855f6157e78034024e8f5e3ba052;hp=8afb9a37921c13127577a5cd8e129517b58bc46d;hpb=cec39fc8ec218fa1258961f1d0f955a3a72d5bb0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/strict.pm b/lib/strict.pm index 8afb9a3..d1479ed 100644 --- a/lib/strict.pm +++ b/lib/strict.pm @@ -1,5 +1,40 @@ package strict; +$strict::VERSION = "1.02"; + +my %bitmask = ( +refs => 0x00000002, +subs => 0x00000200, +vars => 0x00000400 +); + +sub bits { + my $bits = 0; + my @wrong; + foreach my $s (@_) { + push @wrong, $s unless exists $bitmask{$s}; + $bits |= $bitmask{$s} || 0; + } + if (@wrong) { + require Carp; + Carp::croak("Unknown 'strict' tag(s) '@wrong'"); + } + $bits; +} + +sub import { + shift; + $^H |= bits(@_ ? @_ : qw(refs subs vars)); +} + +sub unimport { + shift; + $^H &= ~ bits(@_ ? @_ : qw(refs subs vars)); +} + +1; +__END__ + =head1 NAME strict - Perl pragma to restrict unsafe constructs @@ -87,31 +122,4 @@ appears in curly braces or on the left hand side of the "=E" symbol. See L. - =cut - -$strict::VERSION = "1.01"; - -my %bitmask = ( -refs => 0x00000002, -subs => 0x00000200, -vars => 0x00000400 -); - -sub bits { - my $bits = 0; - foreach my $s (@_){ $bits |= $bitmask{$s} || 0; }; - $bits; -} - -sub import { - shift; - $^H |= bits(@_ ? @_ : qw(refs subs vars)); -} - -sub unimport { - shift; - $^H &= ~ bits(@_ ? @_ : qw(refs subs vars)); -} - -1;