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