X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstrict.pm;h=d1479ed865ee1dd4c627f6d08ec90728f628c70c;hb=c9bca74aca217023baf0f921dcffaaa072a83cf3;hp=c89edbf00f128438bc4728e913e43a6de7186e15;hpb=210bfd0c35c99ac9c680d43346a302335cf8c627;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/strict.pm b/lib/strict.pm index c89edbf..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,43 +122,4 @@ appears in curly braces or on the left hand side of the "=E" symbol. See L. - =cut - -$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) { - my $useno = { - __PACKAGE__.'::import' => 'use', - __PACKAGE__.'::unimport' => 'no' - }->{ (caller(1))[3] }; - require Carp; - Carp::croak("Don't know how to '$useno ".__PACKAGE__." qw(@wrong)'"); - } - $bits; -} - -sub import { - shift; - $^H |= bits(@_ ? @_ : qw(refs subs vars)); -} - -sub unimport { - shift; - $^H &= ~ bits(@_ ? @_ : qw(refs subs vars)); -} - -1;