view release on metacpan or  search on metacpan

lib/strictures.pm  view on Meta::CPAN

  severe
    debugging
    inplace
    internal
    malloc
  shadow
  signal
  substr
  syntax
    ambiguous
    bareword
    digit
    illegalproto
    parenthesis
    precedence
    printf
    prototype
    qw
    reserved
    semicolon
  taint
  threads
  uninitialized
  umask
  unpack
  untie
  utf8
    non_unicode
    nonchar
    surrogate
  void
  void_unusual
  y2k
);

sub VERSION {
  {
    no warnings;
    local $@;
    if (defined $_[1] && eval { &UNIVERSAL::VERSION; 1}) {
      $^H |= 0x20000
        unless _PERL_LT_5_8_4;
      $^H{strictures_enable} = int $_[1];
    }
  }
  _CAN_GOTO_VERSION ? goto &UNIVERSAL::VERSION : &UNIVERSAL::VERSION;
}

our %extra_load_states;

our $Smells_Like_VCS;

sub import {
  my $class = shift;
  my %opts = @_ == 1 ? %{$_[0]} : @_;
  if (!exists $opts{version}) {
    $opts{version}
      = exists $^H{strictures_enable} ? delete $^H{strictures_enable}
      : int $VERSION;
  }
  $opts{file} = (caller)[1];
  $class->_enable(\%opts);
}

sub _enable {
  my ($class, $opts) = @_;
  my $version = $opts->{version};
  $version = 'undef'
    if !defined $version;
  my $method = "_enable_$version";
  if (!$class->can($method)) {
    require Carp;
    Carp::croak("Major version specified as $version - not supported!");
  }
  $class->$method($opts);
}

sub _enable_1 {
  my ($class, $opts) = @_;
  strict->import;
  warnings->import(FATAL => 'all');

  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'};
  }
}

our @V2_NONFATAL = grep { exists $warnings::Offsets{$_} } (
  'exec',         # not safe to catch
  'recursion',    # will be caught by other mechanisms
  'internal',     # not safe to catch
  'malloc',       # not safe to catch
  'newline',      # stat on nonexistent file with a newline in it
  'experimental', # no reason for these to be fatal
  'deprecated',   # unfortunately can't make these fatal
  'portable',     # everything worked fine here, just may not elsewhere
);
our @V2_DISABLE = grep { exists $warnings::Offsets{$_} } (
  'once'          # triggers inconsistently, can't be fatalized
);

sub _enable_2 {
  my ($class, $opts) = @_;
  strict->import;
  warnings->import;
  warnings->import(FATAL => @WARNING_CATEGORIES);
  warnings->unimport(FATAL => @V2_NONFATAL);
  warnings->import(@V2_NONFATAL);
  warnings->unimport(@V2_DISABLE);

  if (_want_extra($opts->{file})) {
    _load_extras(qw(indirect multidimensional bareword::filehandles));
    indirect->unimport(':fatal')
      if $extra_load_states{indirect};
    multidimensional->unimport

lib/strictures.pm  view on Meta::CPAN

  foreach my $mod (@extras) {
    next
      if exists $extra_load_states{$mod};

    $extra_load_states{$mod} = eval "require $mod; 1;" or do {
      push @failed, $mod;

      #work around 5.8 require bug
      (my $file = $mod) =~ s|::|/|g;
      delete $INC{"${file}.pm"};
    };
  }

  if (@failed) {
    my $failed = join ' ', @failed;
    my $extras = join ' ', @extras;
    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:

  cpan $extras

but these modules are not required by your users.
EOE
  }
}

1;

__END__
=head1 NAME

strictures - Turn on strict and make most warnings fatal

=head1 SYNOPSIS

  use strictures 2;

is equivalent to

  use strict;
  use warnings FATAL => 'all';
  use warnings NONFATAL => qw(
    exec
    recursion
    internal
    malloc
    newline
    experimental
    deprecated
    portable
  );
  no warnings 'once';

except when called from a file which matches:

  (caller)[1] =~ /^(?:t|xt|lib|blib)[\\\/]/

and when either C<.git>, C<.svn>, C<.hg>, or C<.bzr> is present in the current
directory (with the intention of only forcing extra tests on the author side)
-- or when C<.git>, C<.svn>, C<.hg>, or C<.bzr> 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 it also does the equivalent of

  no indirect 'fatal';
  no multidimensional;
  no bareword::filehandles;

Note that C<PERL_STRICTURES_EXTRA> may at some point add even more tests, with
only a minor version increase, but any changes to the effect of C<use
strictures> in normal mode will involve a major version bump.

If any of the extra testing modules are not present, L<strictures> will
complain loudly, once, via C<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
about a year now. I figured it was time to make it shorter.

Things like the importer in C<use Moose> don't help me because they turn
warnings on but don't make them fatal -- which from my point of view is
useless because I want an exception to tell me my code isn't warnings-clean.

Any time I see a warning from my code, that indicates a mistake.

Any time my code encounters a mistake, I want a crash -- not spew to STDERR
and then unknown (and probably undesired) subsequent behaviour.

I also want to ensure that obvious coding mistakes, like indirect object
syntax (and not so obvious mistakes that cause things to accidentally compile
as such) get caught, but not at the cost of an XS dependency and not at the
cost of blowing things up on another machine.

Therefore, L<strictures> turns on additional checking, but only when it thinks
it's running in a test file in a VCS checkout -- although if this causes
undesired behaviour this can be overridden by setting the
C<PERL_STRICTURES_EXTRA> environment variable.

If additional useful author side checks come to mind, I'll add them to the
C<PERL_STRICTURES_EXTRA> code path only -- this will result in a minor version
increase (e.g. 1.000000 to 1.001000 (1.1.0) or similar). Any fixes only to the
mechanism of this code will result in a sub-version increase (e.g. 1.000000 to
1.000001 (1.0.1)).

=head1 CATEGORY SELECTIONS

strictures does not enable fatal warnings for all categories.

=over 4

=item exec

Includes a warning that can cause your program to continue running
unintentionally after an internal fork.  Not safe to fatalize.