File Coverage

blib/lib/Perl/Critic/Policy/Documentation/RequireFinalCut.pm
Criterion Covered Total %
statement 72 76 94.7
branch 13 16 81.2
condition 6 6 100.0
subroutine 21 21 100.0
pod 1 1 100.0
total 113 120 94.1


line stmt bran cond sub pod time code
1             # Copyright 2012, 2013, 2014, 2015, 2016, 2017, 2019 Kevin Ryde
2              
3             # This file is part of Perl-Critic-Pulp.
4              
5             # Perl-Critic-Pulp is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Perl-Critic-Pulp is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
17              
18              
19             # perlcritic -s RequireFinalCut RequireFinalCut.pm
20             # perlcritic -s RequireFinalCut /usr/share/perl5/Class/InsideOut.pm
21             # perlcritic -s RequireFinalCut /usr/share/perl5/Lingua/Any/Numbers.pm
22              
23              
24             package Perl::Critic::Policy::Documentation::RequireFinalCut;
25 40     40   31878 use 5.006;
  40         163  
26 40     40   231 use strict;
  40         87  
  40         921  
27 40     40   209 use warnings;
  40         90  
  40         1104  
28 40     40   280 use base 'Perl::Critic::Policy';
  40         104  
  40         5640  
29 40     40   190000 use Perl::Critic::Utils;
  40         98  
  40         1372  
30              
31             # uncomment this to run the ### lines
32             # use Smart::Comments;
33              
34             our $VERSION = 98;
35              
36 40     40   35525 use constant supported_parameters => ();
  40         102  
  40         2735  
37 40     40   256 use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOWEST;
  40         105  
  40         2489  
38 40     40   270 use constant default_themes => qw(pulp cosmetic);
  40         91  
  40         2342  
39 40     40   264 use constant applies_to => 'PPI::Document';
  40         96  
  40         5213  
40              
41             sub violates {
42 31     31 1 570591 my ($self, $elem, $document) = @_;
43             ### RequireFinalCut on: $elem->content
44              
45 31         201 my $parser = Perl::Critic::Pulp::PodParser::RequireFinalCut->new
46             (policy => $self);
47 31         117 $parser->parse_from_elem ($elem);
48 31         139 return $parser->violations;
49             }
50              
51             package Perl::Critic::Pulp::PodParser::RequireFinalCut;
52 40     40   312 use strict;
  40         110  
  40         1085  
53 40     40   233 use warnings;
  40         106  
  40         1349  
54 40     40   288 use base 'Perl::Critic::Pulp::PodParser';
  40         111  
  40         25591  
55              
56             sub new {
57 31     31   95 my $class = shift;
58 31         286 my $self = $class->SUPER::new (@_);
59 31         313 $self->parseopts(-process_cut_cmd => 1);
60 31         80 return $self;
61             }
62              
63             # Pod::Parser doesn't hold the current line number except in a local
64             # variable, so have to note it here for use in end_input().
65             #
66             sub begin_input {
67 28     28   72 my $self = shift;
68 28         91 $self->SUPER::begin_input(@_);
69 28         339 $self->{'last_linenum'} = 0;
70             }
71             sub preprocess_line {
72 113     113   2987 my ($self, $line, $linenum) = @_;
73             ### preprocess_line(): "linenum=$linenum"
74 113         212 $self->{'last_linenum'} = $linenum;
75 113         1508 return $line;
76             }
77              
78             sub end_input {
79 28     28   71 my $self = shift;
80 28         88 $self->SUPER::begin_input(@_);
81 28 100 100     305 if ($self->{'in_pod'}
82             && ! $self->{'saw_cut_in_text'}) {
83             $self->violation_at_linenum_and_textpos
84             ("POD doesn't end with =cut directive",
85 7         37 $self->{'last_linenum'} + 1, # end of file as the position
86             '',
87             0);
88             }
89             }
90              
91             sub command {
92 49     49   1032 my $self = shift;
93 49         181 $self->SUPER::command(@_);
94 49         122 my ($command, $text, $linenum, $paraobj) = @_;
95             ### $command
96             ### $text
97              
98 49 100 100     234 if ($command eq 'cut') {
    100          
    100          
99 10         31 $self->{'in_pod'} = 0;
100              
101             } elsif ($command eq 'end' || $command eq 'for') {
102              
103             } elsif ($command eq 'pod') {
104 15         67 $self->{'in_pod'} = 1;
105              
106             } else {
107 13 100       46 unless ($self->{'in_begin'}) {
108 3         10 $self->{'in_pod'} = 1;
109             }
110             }
111             ### now in_pod: $self->{'in_pod'}
112              
113 49         134 $self->my_notice_cut($text);
114 49         431 return '';
115             }
116              
117             sub verbatim {
118 4     4   13 my ($self, $text, $linenum, $paraobj) = @_;
119             ### verbatim ...
120              
121             # ignore entirely whitespace runs of blank lines
122 4 50       54 return '' if $text =~ /^\s*$/;
123              
124 0 0       0 unless ($self->{'in_begin'}) {
125 0         0 $self->{'in_pod'} = 1;
126             }
127 0         0 $self->my_notice_cut($text);
128 0         0 return '';
129             }
130              
131             sub textblock {
132 13     13   119 my ($self, $text, $linenum, $paraobj) = @_;
133             ### textblock ...
134             ### $text
135              
136 13 100       40 unless ($self->{'in_begin'}) {
137 5         13 $self->{'in_pod'} = 1;
138             }
139 13         39 $self->my_notice_cut($text);
140 13         95 return '';
141             }
142              
143             sub my_notice_cut {
144 62     62   132 my ($self, $text) = @_;
145 62         176 $self->{'saw_cut_in_text'} = ($text =~ /\n=cut\b[^\n]*/);
146             }
147              
148             1;
149             __END__
150              
151             =for stopwords Ryde
152              
153             =head1 NAME
154              
155             Perl::Critic::Policy::Documentation::RequireFinalCut - end POD with =cut directive
156              
157             =head1 DESCRIPTION
158              
159             This policy is part of the L<C<Perl::Critic::Pulp>|Perl::Critic::Pulp>
160             add-on. It asks you to end POD with a C<=cut> directive at the end of a
161             file.
162              
163             =head1 DOCO
164              
165             Some text.
166              
167             =cut # ok
168              
169             The idea is to have a definite end indication for human readers. Perl and
170             the POD processors don't require a final C<=cut>. On that basis this policy
171             is lowest severity and under the "cosmetic" theme (see L<Perl::Critic/POLICY
172             THEMES>).
173              
174             If there's no POD in the file then a C<=cut> is not required. Or if the
175             file ends with code rather than POD then a C<=cut> after that code is not
176             required.
177              
178             =head2 About foo
179              
180             =cut
181              
182             sub foo {
183             } # ok, file ends with code not POD
184              
185             If there's POD at end of file but consists only of C<=begin/=end> blocks
186             then a C<=cut> is not required. It's reckoned the C<=end> is enough in this
187             case.
188              
189             =begin wikidoc
190              
191             Entire document in wiki style.
192              
193             =end wikidoc # ok, =cut not required
194              
195             If the file ends with a mixture of ordinary POD and C<=begin> blocks then a
196             is still required. The special allowance is when only C<=begin> blocks,
197             presumably destined for some other markup system.
198              
199             =head2 Blank Line
200              
201             Generally a C<=cut> should have a blank line before it, the same as other
202             POD commands. But Perl execution doesn't enforce that and the same
203             looseness is permitted here,
204              
205             =pod
206              
207             Blah blah blah
208             =cut # ok without preceding newline
209              
210             A check for blanks around POD commands is left to other policies. The
211             C<podchecker> program reports this (L<Pod::Checker>).
212              
213             =cut
214              
215             # The POD parsers vary a little in their treatment of this sort of thing.
216             # C<Pod::Parser> takes it as part of the paragraph, C<Pod::Simple> takes it as
217             # a command but may issue warnings.
218              
219             =pod
220              
221             =head2 Disabling
222              
223             If you don't care about a final C<=cut> you can disable C<RequireFinalCut>
224             from your F<.perlcriticrc> in the usual way (see
225             L<Perl::Critic/CONFIGURATION>),
226              
227             [-Documentation::RequireFinalCut]
228              
229             =head1 SEE ALSO
230              
231             L<Perl::Critic::Pulp>, L<Perl::Critic>
232              
233             L<Perl::Critic::Policy::Documentation::RequireEndBeforeLastPod>,
234             L<Perl::Critic::Policy::Documentation::RequirePodAtEnd>
235              
236             =head1 HOME PAGE
237              
238             L<http://user42.tuxfamily.org/perl-critic-pulp/index.html>
239              
240             =head1 COPYRIGHT
241              
242             Copyright 2012, 2013, 2014, 2015, 2016, 2017, 2019 Kevin Ryde
243              
244             Perl-Critic-Pulp is free software; you can redistribute it and/or modify it
245             under the terms of the GNU General Public License as published by the Free
246             Software Foundation; either version 3, or (at your option) any later
247             version.
248              
249             Perl-Critic-Pulp is distributed in the hope that it will be useful, but
250             WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
251             or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
252             more details.
253              
254             You should have received a copy of the GNU General Public License along with
255             Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
256              
257             =cut