X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstrictures.pm;h=43a6600cfbd8a47ec803667235c8a6dd9dd110fb;hb=1c35787c75148e768b8c61eb9aec45d6b0ea3949;hp=f14f7e9e0daea9309b5555bbef363992e3e7e63c;hpb=9d763997aceafbe007f36a847780a2d0293f3468;p=p5sagit%2Fstrictures.git

diff --git a/lib/strictures.pm b/lib/strictures.pm
index f14f7e9..43a6600 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 $@;
@@ -44,7 +103,8 @@ sub _enable {
     if !defined $version;
   my $method = "_enable_$version";
   if (!$class->can($method)) {
-    die "Major version specified as $version - not supported!";
+    require Carp;
+    Carp::croak("Major version specified as $version - not supported!");
   }
   $class->$method($opts);
 }
@@ -65,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}) {
@@ -136,12 +229,23 @@ strictures - turn on strict and make all warnings fatal
 
 =head1 SYNOPSIS
 
-  use strictures 1;
+  use strictures 2;
 
 is equivalent to
 
   use strict;
   use warnings FATAL => 'all';
+  use warnings NONFATAL => qw(
+    exec
+    recursion
+    internal
+    malloc
+    newline
+    experimental
+    deprecated
+    portable
+  );
+  no warnings 'once';
 
 except when called from a file which matches:
 
@@ -154,12 +258,23 @@ C<dist.ini> (which would indicate we are in a C<dzil test> operation, via
 L<Dist::Zilla>) -- or when the C<PERL_STRICTURES_EXTRA> environment variable is
 set, in which case
 
-  use strictures 1;
+  use strictures 2;
 
 is equivalent to
 
   use strict;
   use warnings FATAL => 'all';
+  use warnings NONFATAL => qw(
+    exec
+    recursion
+    internal
+    malloc
+    newline
+    experimental
+    deprecated
+    portable
+  );
+  no warnings 'once';
   no indirect 'fatal';
   no multidimensional;
   no bareword::filehandles;
@@ -202,20 +317,47 @@ increase (e.g. 1.000000 to 1.001000 (1.1.0) or similar). Any fixes only to the
 mechanism of this code will result in a sub-version increase (e.g. 1.000000 to
 1.000001 (1.0.1)).
 
-If the behaviour of C<use strictures> in normal mode changes in any way, that
-will constitute a major version increase -- and the code already checks
-when its version is tested to ensure that
+=head1 VERSIONS
+
+Depending on the version of strictures requested, different warnings will be
+enabled.  If no specific version is requested, the current version's behavior
+will be used.  Versions can be requested using perl's standard mechanism:
 
-  use strictures 1;
+  use strictures 2;
 
-will continue to only introduce the current set of strictures even if 2.0 is
-installed.
+Or, by passing in a C<version> option:
+
+  use strictures version => 2;
+
+=head2 VERSION 2
+
+Equivalent to:
+
+  use strict;
+  use warnings FATAL => 'all';
+  use warnings NONFATAL => 'deprecated', 'experimental';
+  # and if in dev mode:
+  no indirect 'fatal';
+  no multidimensional;
+  no bareword::filehandles;
+
+=head2 VERSION 1
+
+Equivalent to:
+
+  use strict;
+  use warnings FATAL => 'all';
+  # and if in dev mode:
+  no indirect 'fatal';
+  no multidimensional;
+  no bareword::filehandles;
 
 =head1 METHODS
 
 =head2 import
 
-This method does the setup work described above in L</DESCRIPTION>
+This method does the setup work described above in L</DESCRIPTION>.  Optionally
+accepts a C<version> option to request a specific version's behavior.
 
 =head2 VERSION