X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstrictures.pm;h=64ddd44363ce23ababe940b078b7d78445a5ce71;hb=a97f64c71c45ac0fd5c85472978ac4fc2d9f4188;hp=a865d7736aff1ddf789d20a27d3d8d1a32653255;hpb=8f0df510535f01d82740865bf25e3fc29631c772;p=p5sagit%2Fstrictures.git

diff --git a/lib/strictures.pm b/lib/strictures.pm
index a865d77..64ddd44 100644
--- a/lib/strictures.pm
+++ b/lib/strictures.pm
@@ -33,6 +33,7 @@ sub import {
       = exists $^H{strictures_enable} ? delete $^H{strictures_enable}
       : int $VERSION;
   }
+  $opts{file} = (caller)[1];
   $class->_enable(\%opts);
 }
 
@@ -43,44 +44,58 @@ 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);
 }
 
 sub _enable_1 {
+  my ($class, $opts) = @_;
   strict->import;
   warnings->import(FATAL => 'all');
 
-  _load_extras(qw(indirect multidimensional bareword::filehandles))
-    or return;
-  indirect->unimport(':fatal') if $extra_load_states{indirect};
-  multidimensional->unimport if $extra_load_states{multidimensional};
-  bareword::filehandles->unimport if $extra_load_states{'bareword::filehandles'};
+  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 _load_extras {
-  my @extras = @_;
-  my $extra_tests = do {
-    if (exists $ENV{PERL_STRICTURES_EXTRA}) {
-      if (_PERL_LT_5_8_4 and $ENV{PERL_STRICTURES_EXTRA}) {
-        die 'PERL_STRICTURES_EXTRA checks are not available on perls older than 5.8.4: '
-          . "please unset \$ENV{PERL_STRICTURES_EXTRA}\n";
-      }
-      $ENV{PERL_STRICTURES_EXTRA};
-    } elsif (! _PERL_LT_5_8_4) {
-      (caller(4))[1] =~ /^(?:t|xt|lib|blib)[\\\/]/
-        and defined $Smells_Like_VCS ? $Smells_Like_VCS
-          : ( $Smells_Like_VCS = !!(
-            -e '.git' || -e '.svn' || -e '.hg'
-            || (-e '../../dist.ini'
-              && (-e '../../.git' || -e '../../.svn' || -e '../../.hg' ))
-          ))
+sub _want_extra_env {
+  if (exists $ENV{PERL_STRICTURES_EXTRA}) {
+    if (_PERL_LT_5_8_4 and $ENV{PERL_STRICTURES_EXTRA}) {
+      die 'PERL_STRICTURES_EXTRA checks are not available on perls older'
+        . "than 5.8.4: please unset \$ENV{PERL_STRICTURES_EXTRA}\n";
     }
-  };
-  return
-    unless $extra_tests;
+    return $ENV{PERL_STRICTURES_EXTRA} ? 1 : 0;
+  }
+  return undef;
+}
+
+sub _want_extra {
+  my $file = shift;
+  my $want_env = _want_extra_env();
+  return $want_env
+    if defined $want_env;
+  return (
+    !_PERL_LT_5_8_4
+    and $file =~ /^(?:t|xt|lib|blib)[\\\/]/
+    and defined $Smells_Like_VCS ? $Smells_Like_VCS
+      : ( $Smells_Like_VCS = !!(
+        -e '.git' || -e '.svn' || -e '.hg'
+        || (-e '../../dist.ini'
+          && (-e '../../.git' || -e '../../.svn' || -e '../../.hg' ))
+      ))
+  );
+}
 
+sub _load_extras {
+  my @extras = @_;
   my @failed;
   foreach my $mod (@extras) {
     next
@@ -111,7 +126,6 @@ of a strictures-using module you need to run:
 but these modules are not required by your users.
 EOE
   }
-  return $extra_tests;
 }
 
 1;