From: Graham Knop <haarg@haarg.org>
Date: Mon, 6 Jan 2014 12:00:22 +0000 (-0500)
Subject: refactor file checking for extras
X-Git-Tag: v1.999_001~1^2~18
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c5a67be6e1a9aa58c86d34968262c4bcf770d73e;p=p5sagit%2Fstrictures.git

refactor file checking for extras
---

diff --git a/lib/strictures.pm b/lib/strictures.pm
index a865d77..e1fe753 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);
 }
 
@@ -49,38 +50,44 @@ sub _enable {
 }
 
 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 {
+  my $file = shift;
+  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};
+  }
+  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 +118,6 @@ of a strictures-using module you need to run:
 but these modules are not required by your users.
 EOE
   }
-  return $extra_tests;
 }
 
 1;