File Coverage

blib/lib/Perl/Critic/Policy/Documentation/ProhibitDuplicateSeeAlso.pm
Criterion Covered Total %
statement 64 64 100.0
branch 11 12 91.6
condition 3 3 100.0
subroutine 17 17 100.0
pod 1 1 100.0
total 96 97 98.9


line stmt bran cond sub pod time code
1             # Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017 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 ProhibitDuplicateSeeAlso ProhibitDuplicateSeeAlso.pm
20              
21              
22             package Perl::Critic::Policy::Documentation::ProhibitDuplicateSeeAlso;
23 40     40   24990 use 5.006;
  40         286  
24 40     40   386 use strict;
  40         195  
  40         910  
25 40     40   247 use warnings;
  40         221  
  40         1021  
26 40     40   214 use base 'Perl::Critic::Policy';
  40         227  
  40         3627  
27 40     40   143565 use Perl::Critic::Utils;
  40         85  
  40         522  
28              
29             # uncomment this to run the ### lines
30             #use Smart::Comments;
31              
32             our $VERSION = 97;
33              
34 40     40   30221 use constant supported_parameters => ();
  40         86  
  40         2074  
35 40     40   206 use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW;
  40         189  
  40         2080  
36 40     40   236 use constant default_themes => qw(pulp cosmetic);
  40         73  
  40         1877  
37 40     40   299 use constant applies_to => 'PPI::Document';
  40         85  
  40         4257  
38              
39             sub violates {
40 8     8 1 545584 my ($self, $elem, $document) = @_;
41             # ### ProhibitDuplicateSeeAlso on: $elem->content
42              
43 8         115 my $parser = Perl::Critic::Pulp::PodParser::ProhibitDuplicateSeeAlso->new
44             (policy => $self);
45 8         33 $parser->parse_from_elem ($elem);
46 8         31 return $parser->violations;
47             }
48              
49             package Perl::Critic::Pulp::PodParser::ProhibitDuplicateSeeAlso;
50 40     40   284 use strict;
  40         100  
  40         926  
51 40     40   315 use warnings;
  40         84  
  40         1114  
52 40     40   601 use Pod::ParseLink;
  40         800  
  40         1823  
53 40     40   309 use base 'Perl::Critic::Pulp::PodParser';
  40         1710  
  40         16519  
54              
55             sub command {
56 11     11   846 my $self = shift;
57 11         24 my ($command, $text, $linenum, $paraobj) = @_;
58 11         44 $self->SUPER::command(@_); # maintain 'in_begin'
59              
60 11 100       31 if ($command eq 'head1') {
61 9         38 $self->{'in_see_also'} = ($text =~ /^\s*SEE\s+ALSO\b/);
62             ### in_see_also: $self->{'in_see_also'}
63             }
64 11         38 return $self->command_as_textblock(@_);
65             }
66              
67             sub textblock {
68 20     20   670 my ($self, $text, $linenum, $pod_obj) = @_;
69             ### textblock(): "linenum=$linenum"
70             ### $text
71              
72             # Ignore all =begin blocks for now.
73             #
74             # Distinct "=begin :foo" and "=begin :bar" blocks would be mutually
75             # exclusive and duplicates between don't matter.
76             #
77             # Multiple blocks "=begin :foo" or of an =begin and non-begin should not
78             # duplicate, but expect such things to be rare.
79             #
80 20 100       58 unless ($self->{'in_begin'} eq '') {
81 1         8 return '';
82             }
83              
84 19         1060 $self->interpolate($text, $linenum);
85 19         244 return '';
86             }
87              
88             sub interior_sequence {
89 16     16   51 my ($self, $cmd, $text, $pod_obj) = @_;
90             ### interior_sequence() ...
91              
92 16 100 100     74 if ($self->{'in_see_also'} && $cmd eq 'L') {
93 14         45 my ($display, $inferred, $name, $section, $type)
94             = Pod::ParseLink::parselink ($text);
95             ### $name
96             ### $section
97              
98 14 50       536 if (defined $name) {
99 14 100       33 if (! defined $section) { $section = ''; }
  11         16  
100              
101 14         60 (undef, my $linenum) = $pod_obj->file_line;
102 14 100       57 if (defined (my $prev_linenum = $self->{'seen'}->{$name,$section})) {
103              
104 2         19 $self->violation_at_linenum_and_textpos
105             ("Duplicate SEE ALSO link L<$text> (already at line $prev_linenum)",
106             $linenum, '', 0);
107             } else {
108 12         39 $self->{'seen'}->{$name,$section} = $linenum;
109             }
110             }
111             }
112 16         563 return '';
113             }
114              
115             1;
116             __END__
117              
118             =for stopwords Ryde clickable one's formatters filename
119              
120             =head1 NAME
121              
122             Perl::Critic::Policy::Documentation::ProhibitDuplicateSeeAlso - don't duplicate LE<lt>E<gt> links in SEE ALSO
123              
124             =head1 DESCRIPTION
125              
126             This policy is part of the L<C<Perl::Critic::Pulp>|Perl::Critic::Pulp>
127             add-on. It asks you not to duplicate C<< LE<lt>FooE<gt> >> links in a SEE
128             ALSO section.
129              
130             =for ProhibitVerbatimMarkup allow next 3
131              
132             =head1 SEE ALSO
133              
134             L<Foo::Bar>
135              
136             L<Foo::Bar> # bad
137              
138             The idea is that for readability a given cross-reference should be linked
139             just once and a duplicate is likely a leftover from too much cut-and-paste
140             etc. This is minor matter so this policy is low severity and under the
141             C<cosmetic> theme (see L<Perl::Critic/POLICY THEMES>).
142              
143             A module can appear more than once in a SEE ALSO, but only
144             C<< LE<lt>E<gt> >> linked once. Anything else should be C<< CE<lt>E<gt> >>
145             markup or plain text.
146              
147             =for ProhibitVerbatimMarkup allow next
148              
149             L<Foo::One>, L<Foo::Two>
150             (C<Foo::Two> runs faster) # ok
151              
152             Links to different parts of a target POD are allowed,
153              
154             =for ProhibitVerbatimMarkup allow next
155              
156             L<perlfunc/alarm>,
157             L<perlfunc/kill> # ok
158              
159             =head2 Disabling
160              
161             If you don't care about this then you can always disable
162             C<ProhibitDuplicateSeeAlso> from your F<.perlcriticrc> file in the usual way
163             (see L<Perl::Critic/CONFIGURATION>),
164              
165             [-Documentation::ProhibitDuplicateSeeAlso]
166              
167             =head1 SEE ALSO
168              
169             L<Perl::Critic::Pulp>,
170             L<Perl::Critic>
171              
172             L<Perl::Critic::Policy::Documentation::ProhibitAdjacentLinks>,
173             L<Perl::Critic::Policy::Documentation::ProhibitLinkToSelf>
174              
175             =head1 HOME PAGE
176              
177             http://user42.tuxfamily.org/perl-critic-pulp/index.html
178              
179             =head1 COPYRIGHT
180              
181             Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017 Kevin Ryde
182              
183             Perl-Critic-Pulp is free software; you can redistribute it and/or modify it
184             under the terms of the GNU General Public License as published by the Free
185             Software Foundation; either version 3, or (at your option) any later
186             version.
187              
188             Perl-Critic-Pulp is distributed in the hope that it will be useful, but
189             WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
190             or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
191             more details.
192              
193             You should have received a copy of the GNU General Public License along with
194             Perl-Critic-Pulp. If not, see <http://www.gnu.org/licenses/>.
195              
196             =cut