X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstrictures.pm;h=e7882d65d64533ce01a4b7465eb6b39eee2fd981;hb=ffedb166dfd9760a9120a2b28c646300b4491bfa;hp=68ca44c2a7583cb9f5844f662d512bb3efe71f8f;hpb=eae006ee3476346901d8edb6c73b1fed4a98c766;p=p5sagit%2Fstrictures.git diff --git a/lib/strictures.pm b/lib/strictures.pm index 68ca44c..e7882d6 100644 --- a/lib/strictures.pm +++ b/lib/strictures.pm @@ -3,31 +3,73 @@ package strictures; use strict; use warnings FATAL => 'all'; -our $VERSION = '1.000000'; # 1.0.0 +use constant _PERL_LT_5_8_4 => ($] < 5.008004) ? 1 : 0; + +our $VERSION = '1.002002'; # 1.2.2 sub VERSION { for ($_[1]) { 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. + no warnings 'uninitialized'; shift->SUPER::VERSION(@_); } +my $extras_load_warned; + sub import { strict->import; warnings->import(FATAL => 'all'); - my $do_indirect = do { + + my $extra_tests = do { if (exists $ENV{PERL_STRICTURES_EXTRA}) { - $ENV{PERL_STRICTURES_EXTRA} - } else { - !!($0 =~ /^x?t\/.*(?:load|compile|coverage).*\.t$/) + if (_PERL_LT_5_8_4 and $ENV{PERL_STRICTURES_EXTRA}) { + die 'PERL_STRICTUTRES_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) { + !!($0 =~ /^x?t\/.*(?:load|compile|coverage|use_ok).*\.t$/ + and (-e '.git' or -e '.svn')) } }; - if ($do_indirect) { + if ($extra_tests) { + my @failed; if (eval { require indirect; 1 }) { indirect->unimport(':fatal'); } else { - die "strictures.pm extra testing active but couldn't load indirect.pm: $@"; + 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 < 'all'; no indirect 'fatal'; + no multidimensional; + no bareword::filehandles; Note that _EXTRA may at some point add even more tests, with only a minor version increase, but any changes to the effect of 'use strictures' in normal mode will involve a major version bump. +If any of the extra testing modules are not present, strictures will +complain loudly, once, via warn(), and then shut up. But you really +should consider installing them, they're all great anti-footgun tools. + =head1 DESCRIPTION I've been writing the equivalent of this module at the top of my code for @@ -88,7 +137,7 @@ cost of blowing things up on another machine. Therefore, strictures turns on indirect checking only when it thinks it's running in a compilation (or pod coverage) test - though if this causes -undesired behaviour this can be overriden by setting the +undesired behaviour this can be overridden by setting the PERL_STRICTURES_EXTRA environment variable. If additional useful author side checks come to mind, I'll add them to the @@ -133,7 +182,7 @@ Gitweb is on http://git.shadowcat.co.uk/ and the clone URL is: =head1 AUTHOR -Matt S. Trout +mst - Matt S. Trout (cpan:MSTROUT) =head1 CONTRIBUTORS