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


line stmt bran cond sub pod time code
1 7     7   952169 use strict;
  7         13  
  7         172  
2 7     7   23 use warnings;
  7         12  
  7         303  
3             package Perl::Critic::Policy::Lax::RequireEndWithTrueConst;
4             # ABSTRACT: ending your package with a simple, fun true value is okay
5             $Perl::Critic::Policy::Lax::RequireEndWithTrueConst::VERSION = '0.012';
6             #pod =head1 DESCRIPTION
7             #pod
8             #pod This policy behaves like L<Perl::Critic::Policy::Modules::RequireEndWithOne>,
9             #pod but allows frivolity like ending with C<"Club sandwich">.
10             #pod
11             #pod The return value must be the final statement of the module.
12             #pod
13             #pod =head1 WARNINGS
14             #pod
15             #pod There are I<many> true values that this won't actually accept. The biggest
16             #pod issue is returning lists or other comma-delimited values. While it would be
17             #pod nice to support these, they're not the sort of club sandwich with which I
18             #pod usually end my code, so I'm not likely to code the fix myself.
19             #pod
20             #pod Patches welcome.
21             #pod
22             #pod =cut
23              
24 7     7   23 use Perl::Critic::Utils;
  7         6  
  7         97  
25 7     7   3571 use parent qw(Perl::Critic::Policy);
  7         9  
  7         45  
26              
27             my $DESCRIPTION = q{Module does not end with true constant};
28             my $EXPLANATION = q{Must end with a recognizable true value};
29              
30 6     6 1 38 sub default_severity { $SEVERITY_HIGH }
31 0     0 1 0 sub default_themes { qw(lax) }
32 12     12 1 58873 sub applies_to { 'PPI::Document' }
33              
34             sub violates {
35 12     12 1 69 my ($self, $elem, $doc) = @_;
36 12 50       23 return if $doc->is_program; #Must be a library or module.
37              
38             # Last statement should be a true constant.
39 12         102 my @significant = grep { _is_code($_) } $doc->schildren();
  25         219  
40 12         12 my $match = $significant[-1];
41 12 50       32 return if !$match;
42              
43 12 100       18 return if $self->_is_true_enough($match);
44              
45             # Must be a violation...
46 6         30 return $self->violation($DESCRIPTION, $EXPLANATION, $match);
47             }
48              
49             sub _is_true_enough {
50 12     12   11 my ($self, $element) = @_;
51              
52 12 100       31 if ($element->isa('PPI::Statement::Break')) {
53 6         10 my ($head, @tail) = $element->schildren;
54 6 50       52 return unless $head eq 'return';
55 6 50 33     79 pop @tail if $tail[-1]->isa('PPI::Token::Structure')
56             and $tail[-1] eq ';';
57 6         54 $element = $tail[-1]; # If returning a list, only last one matters.
58             }
59              
60 12 100 66     34 if ($element->isa('PPI::Statement') and $element->schildren < 3) {
61 6         66 ($element) = $element->schildren;
62             }
63              
64 12         65 while ($element->isa('PPI::Structure::List')) {
65 2         12 my @list_elements = $element->schildren;
66 2 50       15 return unless @list_elements;
67 2         7 $element = $list_elements[-1];
68             }
69              
70 12 100       28 if ($element->isa('PPI::Token::Number')) {
71 5         9 return $element ne '0'; # Any other number is true.
72             }
73              
74 7 100       20 if ($element->isa('PPI::Token::Quote')) {
75 3         8 my $string = $element->string;
76 3   66     25 return((length $string) and ($string ne '0'));
77             }
78              
79             # PPI::Statement::Expression for lists? Probably too far to the edge.
80              
81 4         6 return;
82             }
83              
84             sub _is_code {
85 25     25   20 my $elem = shift;
86 25   33     143 return ! ($elem->isa('PPI::Statement::End')
87             || $elem->isa('PPI::Statement::Data'));
88             }
89              
90             1;
91              
92             __END__
93              
94             =pod
95              
96             =encoding UTF-8
97              
98             =head1 NAME
99              
100             Perl::Critic::Policy::Lax::RequireEndWithTrueConst - ending your package with a simple, fun true value is okay
101              
102             =head1 VERSION
103              
104             version 0.012
105              
106             =head1 DESCRIPTION
107              
108             This policy behaves like L<Perl::Critic::Policy::Modules::RequireEndWithOne>,
109             but allows frivolity like ending with C<"Club sandwich">.
110              
111             The return value must be the final statement of the module.
112              
113             =head1 WARNINGS
114              
115             There are I<many> true values that this won't actually accept. The biggest
116             issue is returning lists or other comma-delimited values. While it would be
117             nice to support these, they're not the sort of club sandwich with which I
118             usually end my code, so I'm not likely to code the fix myself.
119              
120             Patches welcome.
121              
122             =head1 AUTHOR
123              
124             Ricardo Signes <rjbs@cpan.org>
125              
126             =head1 COPYRIGHT AND LICENSE
127              
128             This software is copyright (c) 2016 by Ricardo Signes <rjbs@cpan.org>.
129              
130             This is free software; you can redistribute it and/or modify it under
131             the same terms as the Perl 5 programming language system itself.
132              
133             =cut