lib/strictures.pm

   1 package strictures;
   2
   3 use strict;
   4 use warnings FATAL => 'all';
   5
   6 use constant _PERL_LT_5_8_4 => ($] < 5.008004) ? 1 : 0;
   7
   8 our $VERSION = '1.003001'; # 1.3.1
   9
  10 sub VERSION {
  11   for ($_[1]) {
  12     last unless defined && !ref && int != 1;
  13     die "Major version specified as $_ - this is strictures version 1";
  14   }
  15   # disable this since Foo->VERSION(undef) correctly returns the version
  16   # and that can happen either if our caller passes undef explicitly or
  17   # because the for above autovivified $_[1] - I could make it stop but
  18   # it's pointless since we don't want to blow up if the caller does
  19   # something valid either.
  20   no warnings 'uninitialized';
  21   shift->SUPER::VERSION(@_);
  22 }
  23
  24 my $extras_load_warned;
  25
  26 sub import {
  27   strict->import;
  28   warnings->import(FATAL => 'all');
  29
  30   my $extra_tests = do {
  31     if (exists $ENV{PERL_STRICTURES_EXTRA}) {
  32       if (_PERL_LT_5_8_4 and $ENV{PERL_STRICTURES_EXTRA}) {
  33         die 'PERL_STRICTUTRES_EXTRA checks are not available on perls older than 5.8.4, '
  34           . "please unset \$ENV{PERL_STRICTURES_EXTRA}\n";
  35       }
  36       $ENV{PERL_STRICTURES_EXTRA};
  37     } elsif (! _PERL_LT_5_8_4) {
  38       !!((caller)[1] =~ /^(?:t|xt|lib|blib)/
  39          and (-e '.git' or -e '.svn'))
  40     }
  41   };
  42   if ($extra_tests) {
  43     my @failed;
  44     if (eval { require indirect; 1 }) {
  45       indirect->unimport(':fatal');
  46     } else {
  47       push @failed, 'indirect';
  48     }
  49     if (eval { require multidimensional; 1 }) {
  50       multidimensional->unimport;
  51     } else {
  52       push @failed, 'multidimensional';
  53     }
  54     if (eval { require bareword::filehandles; 1 }) {
  55       bareword::filehandles->unimport;
  56     } else {
  57       push @failed, 'bareword::filehandles';
  58     }
  59     if (@failed and not $extras_load_warned++) {
  60       my $failed = join ' ', @failed;
  61       warn <<EOE;
  62 strictures.pm extra testing active but couldn't load all modules. Missing were:
  63
  64   $failed
  65
  66 Extra testing is auto-enabled in checkouts only, so if you're the author
  67 of a strictures using module you need to run:
  68
  69   cpan indirect multidimensional bareword::filehandles
  70
  71 but these modules are not required by your users.
  72 EOE
  73     }
  74   }
  75 }
  76
  77 1;
  78
  79 __END__
  80 =head1 NAME
  81
  82 strictures - turn on strict and make all warnings fatal
  83
  84 =head1 SYNOPSIS
  85
  86   use strictures 1;
  87
  88 is equivalent to
  89
  90   use strict;
  91   use warnings FATAL => 'all';
  92
  93 except when called from a file which matches:
  94
  95   (caller)[1] =~ /^(?:t|xt|lib|blib)/
  96
  97 and when either '.git' or '.svn' is present in the current directory (with
  98 the intention of only forcing extra tests on the author side) - or when the
  99 PERL_STRICTURES_EXTRA environment variable is set, in which case
 100
 101   use strictures 1;
 102
 103 is equivalent to
 104
 105   use strict;
 106   use warnings FATAL => 'all';
 107   no indirect 'fatal';
 108   no multidimensional;
 109   no bareword::filehandles;
 110
 111 Note that _EXTRA may at some point add even more tests, with only a minor
 112 version increase, but any changes to the effect of 'use strictures' in
 113 normal mode will involve a major version bump.
 114
 115 If any of the extra testing modules are not present, strictures will
 116 complain loudly, once, via warn(), and then shut up. But you really
 117 should consider installing them, they're all great anti-footgun tools.
 118
 119 =head1 DESCRIPTION
 120
 121 I've been writing the equivalent of this module at the top of my code for
 122 about a year now. I figured it was time to make it shorter.
 123
 124 Things like the importer in 'use Moose' don't help me because they turn
 125 warnings on but don't make them fatal - which from my point of view is
 126 useless because I want an exception to tell me my code isn't warnings clean.
 127
 128 Any time I see a warning from my code, that indicates a mistake.
 129
 130 Any time my code encounters a mistake, I want a crash - not spew to STDERR
 131 and then unknown (and probably undesired) subsequent behaviour.
 132
 133 I also want to ensure that obvious coding mistakes, like indirect object
 134 syntax (and not so obvious mistakes that cause things to accidentally compile
 135 as such) get caught, but not at the cost of an XS dependency and not at the
 136 cost of blowing things up on another machine.
 137
 138 Therefore, strictures turns on additional checking, but only when it thinks
 139 it's running in a test file in a VCS checkout - though if this causes
 140 undesired behaviour this can be overridden by setting the
 141 PERL_STRICTURES_EXTRA environment variable.
 142
 143 If additional useful author side checks come to mind, I'll add them to the
 144 _EXTRA code path only - this will result in a minor version increase (i.e.
 145 1.000000 to 1.001000 (1.1.0) or similar). Any fixes only to the mechanism of
 146 this code will result in a subversion increas (i.e. 1.000000 to 1.000001
 147 (1.0.1)).
 148
 149 If the behaviour of 'use strictures' in normal mode changes in any way, that
 150 will constitute a major version increase - and the code already checks
 151 when its version is tested to ensure that
 152
 153   use strictures 1;
 154
 155 will continue to only introduce the current set of strictures even if 2.0 is
 156 installed.
 157
 158 =head1 METHODS
 159
 160 =head2 import
 161
 162 This method does the setup work described above in L</DESCRIPTION>
 163
 164 =head2 VERSION
 165
 166 This method traps the strictures->VERSION(1) call produced by a use line
 167 with a version number on it and does the version check.
 168
 169 =head1 COMMUNITY AND SUPPORT
 170
 171 =head2 IRC channel
 172
 173 irc.perl.org #toolchain
 174
 175 (or bug 'mst' in query on there or freenode)
 176
 177 =head2 Git repository
 178
 179 Gitweb is on http://git.shadowcat.co.uk/ and the clone URL is:
 180
 181   git clone git://git.shadowcat.co.uk/p5sagit/strictures.git
 182
 183 =head1 AUTHOR
 184
 185 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 186
 187 =head1 CONTRIBUTORS
 188
 189 None required yet. Maybe this module is perfect (hahahahaha ...).
 190
 191 =head1 COPYRIGHT
 192
 193 Copyright (c) 2010 the strictures L</AUTHOR> and L</CONTRIBUTORS>
 194 as listed above.
 195
 196 =head1 LICENSE
 197
 198 This library is free software and may be distributed under the same terms
 199 as perl itself.
 200
 201 =cut