fix ->VERSION calls to query version in newer perls

[p5sagit/strictures.git] / lib / strictures.pm

diff --git a/lib/strictures.pm b/lib/strictures.pm
index 4712f11..7c517b9 100644 (file)
--- a/lib/strictures.pm
+++ b/lib/strictures.pm
@@ -3,28 +3,30 @@ package strictures;
 use strict;
 use warnings FATAL => 'all';
 
-use constant _PERL_LT_5_8_4 => ($] < 5.008004) ? 1 : 0;
+BEGIN {
+  *_PERL_LT_5_8_4 = ($] < 5.008004) ? sub(){1} : sub(){0};
+}
 
-our $VERSION = '1.004002'; # 1.4.2
+our $VERSION = '1.005002'; # 1.5.2
 
 sub VERSION {
-  for ($_[1]) {
+  my ($class, $version) = @_;
+  for ($version) {
     last unless defined && !ref && int != 1;
     die "Major version specified as $_ - this is strictures version 1";
   }
-  # disable this since Foo->VERSION(undef) correctly returns the version
-  # and that can happen either if our caller passes undef explicitly or
-  # because the for above autovivified $_[1] - I could make it stop but
-  # it's pointless since we don't want to blow up if the caller does
-  # something valid either.
+  # passing undef here may either warn or die depending on the version of perl.
+  # we can't match the caller's warning state in this case, so just disable the
+  # warning.
   no warnings 'uninitialized';
   shift->SUPER::VERSION(@_);
 }
 
-my $extras_load_warned;
+our $extra_load_states;
 
-our $Smells_Like_VCS = (-e '.git' || -e '.svn'
-  || (-e '../../dist.ini' && (-e '../../.git' || -e '../../.svn')));
+our $Smells_Like_VCS = (-e '.git' || -e '.svn' || -e '.hg'
+  || (-e '../../dist.ini'
+      && (-e '../../.git' || -e '../../.svn' || -e '../../.hg' )));
 
 sub import {
   strict->import;
@@ -43,37 +45,44 @@ sub import {
     }
   };
   if ($extra_tests) {
-    my @failed;
-    if (eval { require indirect; 1 }) {
-      indirect->unimport(':fatal');
-    } else {
-      push @failed, 'indirect';
-    }
-    if (eval { require multidimensional; 1 }) {
-      multidimensional->unimport;
-    } else {
-      push @failed, 'multidimensional';
-    }
-    if (eval { require bareword::filehandles; 1 }) {
-      bareword::filehandles->unimport;
-    } else {
-      push @failed, 'bareword::filehandles';
-    }
-    if (@failed and not $extras_load_warned++) {
-      my $failed = join ' ', @failed;
-      warn <<EOE;
+    $extra_load_states ||= do {
+
+      my (%rv, @failed);
+      foreach my $mod (qw(indirect multidimensional bareword::filehandles)) {
+        eval "require $mod; \$rv{'$mod'} = 1;" or do {
+          push @failed, $mod;
+
+          # courtesy of the 5.8 require bug
+          # (we do a copy because 5.16.2 at least uses the same read-only
+          # scalars for the qw() list and it doesn't seem worth a $^V check)
+
+          (my $file = $mod) =~ s|::|/|g;
+          delete $INC{"${file}.pm"};
+        };
+      }
+
+      if (@failed) {
+        my $failed = join ' ', @failed;
+        print STDERR <<EOE;
 strictures.pm extra testing active but couldn't load all modules. Missing were:
 
   $failed
 
 Extra testing is auto-enabled in checkouts only, so if you're the author
-of a strictures using module you need to run:
+of a strictures-using module you need to run:
 
   cpan indirect multidimensional bareword::filehandles
 
 but these modules are not required by your users.
 EOE
-    }
+      }
+
+      \%rv;
+    };
+
+    indirect->unimport(':fatal') if $extra_load_states->{indirect};
+    multidimensional->unimport if $extra_load_states->{multidimensional};
+    bareword::filehandles->unimport if $extra_load_states->{'bareword::filehandles'};
   }
 }
 
@@ -97,9 +106,9 @@ except when called from a file which matches:
 
   (caller)[1] =~ /^(?:t|xt|lib|blib)/
 
-and when either C<.git> or C<.svn> is present in the current directory (with
-the intention of only forcing extra tests on the author side) -- or when C<.git>
-or C<.svn> is present two directories up along with C<dist.ini> (which would
+and when either C<.git>, C<.svn>, or C<.hg> is present in the current directory (with
+the intention of only forcing extra tests on the author side) -- or when C<.git>,
+C<.svn>, or C<.hg> is present two directories up along with 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
 
@@ -225,6 +234,24 @@ desirable from a point of view of providing new users with as much safety as pos
 and will allow any future discussion on the subject to focus on "how do we
 minimise annoyance to people deploying from checkouts intentionally".
 
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<indirect>
+
+=item *
+
+L<multidimensional>
+
+=item *
+
+L<bareword::filehandles>
+
+=back
+
 =head1 COMMUNITY AND SUPPORT
 
 =head2 IRC channel
@@ -249,7 +276,11 @@ mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 
 =head1 CONTRIBUTORS
 
-None required yet. Maybe this module is perfect (hahahahaha ...).
+Karen Etheridge (cpan:ETHER) <ether@cpan.org>
+
+Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@gmail.com>
+
+haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
 
 =head1 COPYRIGHT