Perl::Critic::Policy::Lax::RequireExplicitPackage::ExceptForPragmata - Perl::Critic::Policy::Lax::RequireExplicitPackage::ExceptForPragmata documentation

  In general, the first statement of any Perl module or library should be a
  package statement.  Otherwise, all the code that comes before the package
  statement is getting executed in the caller's package, and you have no idea
  who that is.  Good encapsulation and common decency require your module to
  keep its innards to itself.

use strict;
use warnings;

package Perl::Critic::Policy::Lax::RequireExplicitPackage::ExceptForPragmata;

use Perl::Critic::Utils;
use base qw(Perl::Critic::Policy);

our $VERSION = '0.008';

my $EXPLANATION = 'Violates encapsulation';
my $DESCRIPTION = 'Code (other than strict/warnings) not in explicit package';

sub default_severity { $SEVERITY_HIGH  }
sub default_themes   { qw( risky )     }
sub applies_to       { 'PPI::Document' }

sub supported_parameters {
  return (
	   {
	     name => 'allowed_pragmata',
	     description =>
	       'Names of pragmata that are permitted before package declaration',
	     default_string => 'diagnostics feature perlversion strict warnings',
	     behavior => 'string list',
	   },
	   {
	     name => 'exempt_scripts',
	     description => q(Don't require programs to have a package statement.),
	     default_string => '1',
	     behavior => 'boolean',
	   },
	 );
}

sub initialize_if_enabled {
  my($self, $config) = @_;
  # The real parsing was done to spec in supported_parameters, but we
  # convert the list to a hash here for ease of use later.
  $self->{_allowed_pragmata} = { map { {$_ => 1} } @{$self->{_allowed_pragmata}} }
    if ref $self->{_allowed_pragmata} eq 'ARRAY';
  return $TRUE;
}

sub violates {
  my ($self, $elem, $doc) = @_;

  # You can configure this policy to exclude scripts
  return if $self->{_exempt_scripts} && $doc->is_program;

  # Find the first 'package' statement
  my $package_stmnt = $doc->find_first('PPI::Statement::Package');
  my $package_line = $package_stmnt ? $package_stmnt->location()->[0] : undef;

  # Find all statements that aren't 'package' statements
  my $stmnts_ref = $doc->find('PPI::Statement');
  return if !$stmnts_ref;
  my @non_packages =
    grep { not(
      $_->isa('PPI::Statement::Include') && $_->type eq 'use'
      && ( $_->version && exists $self->{_allowed_pragmata}{perlversion} ||
	 exists $self->{_allowed_pragmata}{ $_->module } )
    ) }
    grep { !$_->isa('PPI::Statement::Package') } @{$stmnts_ref};
  return if !@non_packages;

  # If the 'package' statement is not defined, or the other
  # statements appear before the 'package', then it violates.

  my @viols = ();
  for my $statement (@non_packages) {
    my $statement_line = $statement->location->[0];
    if ((not defined $package_line) || ($statement_line < $package_line)) {
      push @viols, $self->violation($DESCRIPTION, $EXPLANATION, $statement);
    }
  }

  return @viols;
}

1;

__END__