line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Copyright 2010, 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
|
|
|
|
|
|
|
package Perl::Critic::Policy::Documentation::RequireLinkedURLs; |
19
|
40
|
|
|
40
|
|
26455
|
use 5.006; |
|
40
|
|
|
|
|
126
|
|
20
|
40
|
|
|
40
|
|
190
|
use strict; |
|
40
|
|
|
|
|
76
|
|
|
40
|
|
|
|
|
731
|
|
21
|
40
|
|
|
40
|
|
163
|
use warnings; |
|
40
|
|
|
|
|
75
|
|
|
40
|
|
|
|
|
771
|
|
22
|
40
|
|
|
40
|
|
671
|
use version (); # but don't import qv() |
|
40
|
|
|
|
|
1547
|
|
|
40
|
|
|
|
|
721
|
|
23
|
40
|
|
|
40
|
|
173
|
use base 'Perl::Critic::Policy'; |
|
40
|
|
|
|
|
74
|
|
|
40
|
|
|
|
|
3830
|
|
24
|
40
|
|
|
40
|
|
140615
|
use Perl::Critic::Utils; |
|
40
|
|
|
|
|
85
|
|
|
40
|
|
|
|
|
577
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# uncomment this to run the ### lines |
27
|
|
|
|
|
|
|
# use Smart::Comments; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# perlcritic -s RequireLinkedURLs RequireLinkedURLs.pm |
30
|
|
|
|
|
|
|
# perlcritic -s RequireLinkedURLs /usr/share/perl5/AnyEvent/HTTP.pm |
31
|
|
|
|
|
|
|
# perlcritic -s RequireLinkedURLs /usr/share/perl5/SVG/Rasterize.pm |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
our $VERSION = 97; |
34
|
|
|
|
|
|
|
|
35
|
40
|
|
|
40
|
|
30204
|
use constant supported_parameters => (); |
|
40
|
|
|
|
|
89
|
|
|
40
|
|
|
|
|
2179
|
|
36
|
40
|
|
|
40
|
|
260
|
use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; |
|
40
|
|
|
|
|
82
|
|
|
40
|
|
|
|
|
3122
|
|
37
|
40
|
|
|
40
|
|
219
|
use constant default_themes => qw(pulp cosmetic); |
|
40
|
|
|
|
|
73
|
|
|
40
|
|
|
|
|
1836
|
|
38
|
40
|
|
|
40
|
|
212
|
use constant applies_to => 'PPI::Document'; |
|
40
|
|
|
|
|
71
|
|
|
40
|
|
|
|
|
6299
|
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my $want_perl = version->new('5.008'); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub violates { |
43
|
39
|
|
|
39
|
1
|
620431
|
my ($self, $elem, $document) = @_; |
44
|
|
|
|
|
|
|
### RequireLinkedURLs violates() ... |
45
|
|
|
|
|
|
|
|
46
|
39
|
|
|
|
|
114
|
my $got_perl = $document->highest_explicit_perl_version; |
47
|
|
|
|
|
|
|
### highest_explicit_perl_version: defined $got_perl && "$got_perl" |
48
|
39
|
100
|
66
|
|
|
6896
|
if (! $got_perl # undef no use 5.x at all |
49
|
|
|
|
|
|
|
|| $want_perl > $got_perl) { # use 5.x too low |
50
|
|
|
|
|
|
|
### no use 5.008 up, or too low |
51
|
4
|
|
|
|
|
11
|
return; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
35
|
|
|
|
|
461
|
my $parser = Perl::Critic::Pulp::PodParser::RequireLinkedURLs->new |
55
|
|
|
|
|
|
|
(policy => $self); |
56
|
35
|
|
|
|
|
124
|
$parser->parse_from_elem ($elem); |
57
|
35
|
|
|
|
|
182
|
return $parser->violations; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
package Perl::Critic::Pulp::PodParser::RequireLinkedURLs; |
61
|
40
|
|
|
40
|
|
260
|
use strict; |
|
40
|
|
|
|
|
89
|
|
|
40
|
|
|
|
|
924
|
|
62
|
40
|
|
|
40
|
|
205
|
use warnings; |
|
40
|
|
|
|
|
95
|
|
|
40
|
|
|
|
|
1152
|
|
63
|
40
|
|
|
40
|
|
199
|
use base 'Perl::Critic::Pulp::PodParser'; |
|
40
|
|
|
|
|
84
|
|
|
40
|
|
|
|
|
20903
|
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub command { |
66
|
41
|
|
|
41
|
|
3028
|
my $self = shift; |
67
|
41
|
|
|
|
|
174
|
$self->SUPER::command(@_); |
68
|
41
|
|
|
|
|
135
|
$self->command_as_textblock(@_); |
69
|
41
|
|
|
|
|
474
|
return ''; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub textblock { |
73
|
64
|
|
|
64
|
|
2011
|
my ($self, $text, $linenum, $paraobj) = @_; |
74
|
|
|
|
|
|
|
### textblock ... |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# process outside =begin, and inside =begin which is ":" markup |
77
|
64
|
100
|
66
|
|
|
202
|
unless ($self->{'in_begin'} eq '' || $self->{'in_begin'} =~ /^:/) { |
78
|
6
|
|
|
|
|
56
|
return ''; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
58
|
|
|
|
|
2978
|
my $expand = $self->interpolate ($text, $linenum); |
82
|
|
|
|
|
|
|
|
83
|
58
|
|
|
|
|
1558
|
my $ptree = $self->parse_text ($text, $linenum); |
84
|
58
|
|
|
|
|
211
|
my @pending = reverse $ptree->children; # depth first by pop() |
85
|
58
|
|
|
|
|
147
|
while (@pending) { |
86
|
77
|
|
|
|
|
120
|
my $obj = pop @pending; |
87
|
77
|
100
|
|
|
|
169
|
if (! ref $obj) { |
88
|
|
|
|
|
|
|
# plain text |
89
|
|
|
|
|
|
|
# 12 3 |
90
|
65
|
|
|
|
|
276
|
while ($obj =~ m{(?<!L<)\b((https?|s?ftp|news|nntp)://(\S+))}g) { |
91
|
30
|
|
|
|
|
89
|
my $pos = pos($obj) - length($1); |
92
|
30
|
|
|
|
|
89
|
my $part = $3; |
93
|
30
|
100
|
|
|
|
62
|
next if _is_bogus_part($part); |
94
|
|
|
|
|
|
|
|
95
|
24
|
|
|
|
|
108
|
$self->violation_at_linenum_and_textpos |
96
|
|
|
|
|
|
|
("URL can helpfully have L<> link markup", |
97
|
|
|
|
|
|
|
$linenum, $obj, $pos); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
} else { |
101
|
|
|
|
|
|
|
# a Pod::InteriorSequence |
102
|
12
|
|
|
|
|
50
|
(undef, $linenum) = $obj->file_line; |
103
|
12
|
|
|
|
|
31
|
my $cmd = $obj->cmd_name; |
104
|
|
|
|
|
|
|
|
105
|
12
|
100
|
|
|
|
28
|
if ($cmd eq 'L') { |
106
|
3
|
|
|
|
|
10
|
next; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
} else { |
109
|
|
|
|
|
|
|
# descend into other like C<> |
110
|
|
|
|
|
|
|
# X<> is included, since markup is allowed in it, and maybe even L<> |
111
|
|
|
|
|
|
|
# to make hyperlinks in the index as such |
112
|
|
|
|
|
|
|
# Z<> is included, though it should normally be empty |
113
|
9
|
50
|
|
|
|
30
|
if (my $subtree = $obj->parse_tree) { |
114
|
9
|
|
|
|
|
31
|
push @pending, reverse $subtree->children; # depth first by pop() |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
} |
119
|
58
|
|
|
|
|
962
|
return ''; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub _is_bogus_part { |
123
|
30
|
|
|
30
|
|
59
|
my ($part) = @_; |
124
|
|
|
|
|
|
|
### _is_bogus_part(): $part |
125
|
30
|
|
|
|
|
138
|
return scalar ($part =~ m{^( |
126
|
|
|
|
|
|
|
(foo|bar|quux|xyzzy|example) |
127
|
|
|
|
|
|
|
\.(org|com|co\.[a-z]+) |
128
|
|
|
|
|
|
|
(\.[a-z.]*)? |
129
|
|
|
|
|
|
|
| |
130
|
|
|
|
|
|
|
host(name)?[:/] |
131
|
|
|
|
|
|
|
| |
132
|
|
|
|
|
|
|
\.\. # ellipsis like http://... |
133
|
|
|
|
|
|
|
)}xi); |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
1; |
137
|
|
|
|
|
|
|
__END__ |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=for stopwords Ryde formatters monospaced monospacing clickable |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=head1 NAME |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
Perl::Critic::Policy::Documentation::RequireLinkedURLs - use LE<lt>E<gt> markup on URLs in POD |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=head1 DESCRIPTION |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
This policy is part of the L<C<Perl::Critic::Pulp>|Perl::Critic::Pulp> |
148
|
|
|
|
|
|
|
add-on. It asks you to put C<LE<lt>E<gt>> markup on URLs in POD text in Perl |
149
|
|
|
|
|
|
|
5.8 and higher. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
use 5.008; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head1 HOME PAGE |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
http://foo.org/mystuff/index.html # bad |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=for ProhibitVerbatimMarkup allow next |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
L<http://foo.org/mystuff/index.html> # good |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
C<LE<lt>E<gt>> markup gives clickable links in C<pod2html> and similar |
162
|
|
|
|
|
|
|
formatters, and even in the plain text formatters may give |
163
|
|
|
|
|
|
|
C<E<lt>http://...E<gt>> style angles around the URL which is a |
164
|
|
|
|
|
|
|
semi-conventional way to delimit from surrounding text and in particular |
165
|
|
|
|
|
|
|
from an immediately following comma or period. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
This is only cosmetic and on that basis this policy is low severity and |
168
|
|
|
|
|
|
|
under the "cosmetic" theme (see L<Perl::Critic/POLICY THEMES>). |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Only plain text parts of the POD are considered. Verbatim paragraphs cannot |
171
|
|
|
|
|
|
|
have C<LE<lt>E<gt>> markup (and it's usually a mistake to put it there, as |
172
|
|
|
|
|
|
|
per |
173
|
|
|
|
|
|
|
L<C<ProhibitVerbatimMarkup>|Perl::Critic::Policy::Documentation::ProhibitVerbatimMarkup>). |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
This is verbatim text, |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
http://somewhere.com # ok in verbatim |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 Perl 5.8 |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
C<LE<lt>http://...E<gt>> linking of URLs is new in the Perl 5.8 POD |
182
|
|
|
|
|
|
|
specification. It comes out badly from the formatters in earlier Perl where |
183
|
|
|
|
|
|
|
the "/" is taken to be a section delimiter. For that reason this policy |
184
|
|
|
|
|
|
|
only applies if there's an explicit C<use 5.008> or higher in the code. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
use 5.005; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=for ProhibitVerbatimMarkup allow next |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=item C<http://foo.org> # ok when don't have Perl 5.8 L<> |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=head2 Bad URLs |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Some obvious intentional dummy URLs like C<LE<lt>http://example.comE<gt>> |
195
|
|
|
|
|
|
|
are ignored. They're examples and won't go anywhere as a clickable link. |
196
|
|
|
|
|
|
|
You might like to put C<CE<lt>E<gt>> on them for a typeface, but that is not |
197
|
|
|
|
|
|
|
required by this policy. Currently ignored URL variations are like |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
http://example.com |
200
|
|
|
|
|
|
|
http://foo.com |
201
|
|
|
|
|
|
|
https://foo.org |
202
|
|
|
|
|
|
|
ftp://bar.org.au |
203
|
|
|
|
|
|
|
http://quux.com.au |
204
|
|
|
|
|
|
|
http://xyzzy.co.uk |
205
|
|
|
|
|
|
|
http://foo.co.nz |
206
|
|
|
|
|
|
|
http://host:port |
207
|
|
|
|
|
|
|
http://... |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
A URL is anything starting C<http://>, C<https://>, C<ftp://>, C<news://> or |
210
|
|
|
|
|
|
|
C<nntp://>. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=head2 Begin Blocks |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Text in any C<=begin :foo> block is checked since C<:> means POD markup and |
215
|
|
|
|
|
|
|
it's likely URLs can be helpfully linked there, even if it's only for some |
216
|
|
|
|
|
|
|
particular formatter. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Other C<=begin> blocks are ignored since C<LE<lt>E<gt>> there will not |
219
|
|
|
|
|
|
|
normally be possible or desirable. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head2 Disabling |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
If you don't care about this, if for instance it's hard enough to get your |
224
|
|
|
|
|
|
|
programmers to write documentation at all without worrying about markup, |
225
|
|
|
|
|
|
|
then disable C<RequireLinkedURLs> from your F<~/.perlcriticrc> file in the |
226
|
|
|
|
|
|
|
usual way (see L<Perl::Critic/CONFIGURATION>), |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
[-Documentation::RequireLinkedURLs] |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 SEE ALSO |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
L<Perl::Critic::Pulp>, |
233
|
|
|
|
|
|
|
L<Perl::Critic>, |
234
|
|
|
|
|
|
|
L<Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText> |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head1 HOME PAGE |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
L<http://user42.tuxfamily.org/perl-critic-pulp/index.html> |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head1 COPYRIGHT |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017 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 |