view release on metacpan or  search on metacpan

lib/strictures.pm  view on Meta::CPAN

    exec
    layer
    newline
    pipe
    syscalls
    unopened
  locale
  misc
  missing
  numeric
  once
  overflow
  pack
  portable
  recursion
  redefine
  redundant
  regexp
  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
);