X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2Fstrictures.git;a=blobdiff_plain;f=lib%2Fstrictures.pm;h=85ea622c7d6fd75797a20ade34d9ab5387728b37;hp=64ddd44363ce23ababe940b078b7d78445a5ce71;hb=23c0b85d1580eb07a49da0096e4913debc21e8fa;hpb=967e00d7d5e8094ad88b79db3c0ae7db9b55d473 diff --git a/lib/strictures.pm b/lib/strictures.pm index 64ddd44..85ea622 100644 --- a/lib/strictures.pm +++ b/lib/strictures.pm @@ -7,9 +7,68 @@ BEGIN { *_PERL_LT_5_8_4 = ($] < 5.008004) ? sub(){1} : sub(){0}; } -our $VERSION = '1.005006'; +our $VERSION = '2.000000'; $VERSION = eval $VERSION; +our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw( + closure + deprecated + exiting + experimental + experimental::lexical_subs + experimental::lexical_topic + experimental::regex_sets + experimental::smartmatch + glob + imprecision + io + closed + exec + layer + newline + pipe + unopened + misc + numeric + once + overflow + pack + portable + recursion + redefine + regexp + severe + debugging + inplace + internal + malloc + signal + substr + syntax + ambiguous + bareword + digit + illegalproto + parenthesis + precedence + printf + prototype + qw + reserved + semicolon + taint + threads + uninitialized + unpack + untie + utf8 + non_unicode + nonchar + surrogate + void + y2k +); + sub VERSION { no warnings; local $@; @@ -66,6 +125,39 @@ sub _enable_1 { } } +our @V2_NONFATAL = grep { exists $warnings::Offsets{$_} } qw( + exec + recursion + internal + malloc + newline + experimental + deprecated + portable +); +our @V2_DISABLE = grep { exists $warnings::Offsets{$_} } qw( + once +); + +sub _enable_2 { + my ($class, $opts) = @_; + strict->import; + warnings->import; + warnings->import(FATAL => @WARNING_CATEGORIES); + warnings->import(NONFATAL => @V2_NONFATAL); + warnings->unimport(@V2_DISABLE); + + if (_want_extra($opts->{file})) { + _load_extras(qw(indirect multidimensional bareword::filehandles)); + indirect->unimport(':fatal') + if $extra_load_states{indirect}; + multidimensional->unimport + if $extra_load_states{multidimensional}; + bareword::filehandles->unimport + if $extra_load_states{'bareword::filehandles'}; + } +} + sub _want_extra_env { if (exists $ENV{PERL_STRICTURES_EXTRA}) { if (_PERL_LT_5_8_4 and $ENV{PERL_STRICTURES_EXTRA}) {