File Coverage

blib/lib/Perl/Critic/Policy/Lax/RequireEndWithTrueConst.pm

Criterion	Covered	Total	%
statement	42	43	97.6
branch	15	20	75.0
condition	6	12	50.0
subroutine	9	10	90.0
pod	4	4	100.0
total	76	89	85.3

use strict;
use warnings;
package Perl::Critic::Policy::Lax::RequireEndWithTrueConst 0.014;
# ABSTRACT: ending your package with a simple, fun true value is okay

#pod =head1 DESCRIPTION
#pod
#pod This policy behaves like L<Perl::Critic::Policy::Modules::RequireEndWithOne>,
#pod but allows frivolity like ending with C<"Club sandwich">.
#pod
#pod The return value must be the final statement of the module.
#pod
#pod =head1 WARNINGS
#pod
#pod There are I<many> true values that this won't actually accept.  The biggest
#pod issue is returning lists or other comma-delimited values.  While it would be
#pod nice to support these, they're not the sort of club sandwich with which I
#pod usually end my code, so I'm not likely to code the fix myself.
#pod
#pod Patches welcome.
#pod
#pod =cut

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

my $DESCRIPTION = q{Module does not end with true constant};
my $EXPLANATION = q{Must end with a recognizable true value};

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

sub violates {
  my ($self, $elem, $doc) = @_;
  return if $doc->is_program; #Must be a library or module.

  # Last statement should be a true constant.
  my @significant = grep { _is_code($_) } $doc->schildren();
  my $match = $significant[-1];
  return if !$match;

  return if $self->_is_true_enough($match);

  # Must be a violation...
  return $self->violation($DESCRIPTION, $EXPLANATION, $match);
}

sub _is_true_enough {
  my ($self, $element) = @_;

  if ($element->isa('PPI::Statement::Break')) {
    my ($head, @tail) = $element->schildren;
    return unless $head eq 'return';
    pop @tail if $tail[-1]->isa('PPI::Token::Structure')
             and $tail[-1] eq ';';
    $element = $tail[-1]; # If returning a list, only last one matters.
  }

  if ($element->isa('PPI::Statement') and $element->schildren < 3) {
    ($element) = $element->schildren;
  }

  while ($element->isa('PPI::Structure::List')) {
    my @list_elements = $element->schildren;
    return unless @list_elements;
    $element = $list_elements[-1];
  }

  if ($element->isa('PPI::Token::Number')) {
    return $element ne '0'; # Any other number is true.
  }

  if ($element->isa('PPI::Token::Quote')) {
    my $string = $element->string;
    return((length $string) and ($string ne '0'));
  }

  # PPI::Statement::Expression for lists?  Probably too far to the edge.

  return;
}

sub _is_code {
  my $elem = shift;
  return ! ($elem->isa('PPI::Statement::End')
        ||  $elem->isa('PPI::Statement::Data'));
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Perl::Critic::Policy::Lax::RequireEndWithTrueConst - ending your package with a simple, fun true value is okay

=head1 VERSION

version 0.014

=head1 DESCRIPTION

This policy behaves like L<Perl::Critic::Policy::Modules::RequireEndWithOne>,
but allows frivolity like ending with C<"Club sandwich">.

The return value must be the final statement of the module.

=head1 PERL VERSION

This library should run on perls released even a long time ago.  It should work
on any version of perl released in the last five years.

Although it may work on older versions of perl, no guarantee is made that the
minimum required version will not be increased.  The version may be increased
for any reason, and there is no promise that patches will be accepted to lower
the minimum required perl.

=head1 WARNINGS

There are I<many> true values that this won't actually accept.  The biggest
issue is returning lists or other comma-delimited values.  While it would be
nice to support these, they're not the sort of club sandwich with which I
usually end my code, so I'm not likely to code the fix myself.

Patches welcome.

=head1 AUTHOR

Ricardo Signes <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2022 by Ricardo Signes <[e-mail]>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut