← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:12 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Policy/Documentation/RequirePodLinksIncludeText.pm
StatementsExecuted 24 statements in 691µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111295µs425µsPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::BEGIN@20Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@20
11116µs16µsPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::BEGIN@10Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@10
1119µs11µsPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::default_severityPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::default_severity
1118µs8µsPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::supported_parametersPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::supported_parameters
1118µs28µsPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::BEGIN@15Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@15
1118µs357µsPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::BEGIN@17Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@17
1118µs68µsPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::BEGIN@18Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@18
1117µs382µsPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::BEGIN@16Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@16
1117µs11µsPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::BEGIN@13Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@13
1117µs18µsPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::BEGIN@12Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@12
0000s0sPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::__ANON__[:127]Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::__ANON__[:127]
0000s0sPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::_allowed_linkPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::_allowed_link
0000s0sPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::applies_toPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::applies_to
0000s0sPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::default_themesPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::default_themes
0000s0sPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::::violatesPerl::Critic::Policy::Documentation::RequirePodLinksIncludeText::violates
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1##############################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6##############################################################################
7
8package Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText;
9
10240µs116µs
# spent 16µs within Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@10 which was called: # once (16µs+0s) by Module::Pluggable::Object::_require at line 10
use 5.006001;
11
12220µs229µs
# spent 18µs (7+11) within Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@12 which was called: # once (7µs+11µs) by Module::Pluggable::Object::_require at line 12
use strict;
# spent 18µs making 1 call to Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@12 # spent 11µs making 1 call to strict::import
13222µs214µs
# spent 11µs (7+4) within Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@13 which was called: # once (7µs+4µs) by Module::Pluggable::Object::_require at line 13
use warnings;
# spent 11µs making 1 call to Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@13 # spent 4µs making 1 call to warnings::import
14
15222µs248µs
# spent 28µs (8+20) within Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@15 which was called: # once (8µs+20µs) by Module::Pluggable::Object::_require at line 15
use Readonly;
# spent 28µs making 1 call to Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@15 # spent 20µs making 1 call to Exporter::import
16225µs2757µs
# spent 382µs (7+375) within Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@16 which was called: # once (7µs+375µs) by Module::Pluggable::Object::_require at line 16
use English qw{ -no_match_vars };
# spent 382µs making 1 call to Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@16 # spent 375µs making 1 call to English::import
17224µs2706µs
# spent 357µs (8+349) within Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@17 which was called: # once (8µs+349µs) by Module::Pluggable::Object::_require at line 17
use Perl::Critic::Utils qw{ :booleans :characters :severities };
# spent 357µs making 1 call to Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@17 # spent 349µs making 1 call to Exporter::import
18223µs2128µs
# spent 68µs (8+60) within Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@18 which was called: # once (8µs+60µs) by Module::Pluggable::Object::_require at line 18
use base 'Perl::Critic::Policy';
# spent 68µs making 1 call to Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@18 # spent 60µs making 1 call to base::import
19
202487µs2441µs
# spent 425µs (295+130) within Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@20 which was called: # once (295µs+130µs) by Module::Pluggable::Object::_require at line 20
use Perl::Critic::Utils::POD::ParseInteriorSequence;
# spent 425µs making 1 call to Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::BEGIN@20 # spent 16µs making 1 call to Exporter::import
21
22#-----------------------------------------------------------------------------
23
241600nsour $VERSION = '1.121';
25
26#-----------------------------------------------------------------------------
27
2812µs133µsReadonly::Scalar my $EXPL => 'Without text, you are at the mercy of the POD translator';
# spent 33µs making 1 call to Readonly::Scalar
29
30#-----------------------------------------------------------------------------
31
32
# spent 8µs within Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::supported_parameters which was called: # once (8µs+0s) by Perl::Critic::Policy::new at line 88 of Perl/Critic/Policy.pm
sub supported_parameters {
33 return (
34 {
35110µs name => 'allow_external_sections',
36 description => 'Allow external sections without text',
37 default_string => '1',
38 behavior => 'boolean',
39 },
40 {
41 name => 'allow_internal_sections',
42 description => 'Allow internal sections without text',
43 default_string => '1',
44 behavior => 'boolean',
45 },
46 );
47}
4812µs
# spent 11µs (9+2) within Perl::Critic::Policy::Documentation::RequirePodLinksIncludeText::default_severity which was called: # once (9µs+2µs) by Perl::Critic::Policy::get_severity at line 331 of Perl/Critic/Policy.pm
sub default_severity { return $SEVERITY_LOW }
49sub default_themes { return qw(core maintenance) }
50sub applies_to { return 'PPI::Token::Pod' }
51
52#-----------------------------------------------------------------------------
53
5411µs122µsReadonly::Scalar my $INCREMENT_NESTING => 1;
# spent 22µs making 1 call to Readonly::Scalar
5511µs121µsReadonly::Scalar my $DECREMENT_NESTING => -1;
# spent 21µs making 1 call to Readonly::Scalar
5612µs144µsReadonly::Hash my %ESCAPE_NESTING => (
# spent 44µs making 1 call to Readonly::Hash
57 '<' => $INCREMENT_NESTING,
58 '>' => $DECREMENT_NESTING,
59);
60
61sub violates {
62 my ( $self, $elem, $doc ) = @_;
63
64 my @violations;
65
66=begin comment
67
68 my $pod = $elem->content();
69
70 # We look for _any_ POD escape, not just L<>. This way we can avoid false
71 # positives on constructions like C<< L<Foo> >>. In an attempt to be
72 # upward compatible (and at a slight (I hope!) risk of false negatives),
73 # we accept any upper case letter as beginning a formatting sequence, not
74 # just [IBCLEFSXZ].
75 SCAN_POD:
76 while ( $pod =~ m/ ( [[:upper:]] ) ( <+ ) /smxg ) {
77
78 # Collect the results of the match.
79 my $formatter = $1;
80 my $link_start = $LAST_MATCH_START[0];
81 my $content_start = $LAST_MATCH_END[0];
82 my $num_brkt = length $2;
83
84 # The only way to handle arbitrarily-nested brackets before Perl
85 # 5.10 is the (??{}) construction, which is _still_ marked
86 # 'experimental' as of 5.12.3 and 5.13.9. Taking them at their
87 # word, I'm going to find the end of the POD escape the hard
88 # way.
89 my $link_end = $link_start + 1;
90 my $nest = 0;
91 while ( 1 ) {
92 $nest += $ESCAPE_NESTING{ substr $pod, $link_end++, 1 } || 0;
93 $nest or last;
94 $link_end < length $pod
95 or last SCAN_POD;
96 }
97
98 # Manually advance past the end of the link so the regular
99 # expression does not find any possible nested formatting.
100 pos $pod = $link_end;
101
102 # If it's not an 'L' formatter, we are not interested.
103 'L' eq $formatter or next;
104
105 # Save both the link itself and its contents for further analysis.
106 my $link = substr $pod, $link_start, $link_end - $link_start;
107 my $content = substr $pod, $content_start,
108 $link_end - $num_brkt - $content_start;
109
110 # If the link is allowed, pass on to the next one.
111 $self->_allowed_link( $content ) and next;
112
113 # A-Hah! Gotcha!
114 my $line_number = $elem->line_number() + (
115 substr( $pod, 0, $link_start ) =~ tr/\n/\n/ );
116 push @violations, $self->violation(
117 "Link $link on line $line_number does not specify text",
118 $EXPL, $elem );
119
120 }
121
122=end comment
123
124=cut
125
126 my $parser = Perl::Critic::Utils::POD::ParseInteriorSequence->new();
127 $parser->errorsub( sub { return 1 } ); # Suppress error messages.
128
129 foreach my $seq ( $parser->get_interior_sequences( $elem->content() ) ) {
130
131 # Not interested in nested thing like C<< L<Foo> >>. I think.
132 $seq->nested() and next;
133
134 # Not interested in anything but L<...>.
135 'L' eq $seq->cmd_name() or next;
136
137 # If the link is allowed, pass on to the next one.
138 $self->_allowed_link( $seq ) and next;
139
140 # A-Hah! Gotcha!
141 my $line_number = $elem->line_number() + ( $seq->file_line() )[1] - 1;
142 push @violations, $self->violation(
143 join( $SPACE, 'Link', $seq->raw_text(),
144 "on line $line_number does not specify text" ),
145 $EXPL, $elem );
146 }
147
148 return @violations;
149}
150
151sub _allowed_link {
152
153=begin comment
154
155 my ( $self, $content ) = @_;
156
157=end comment
158
159=cut
160
161 my ( $self, $pod_seq ) = @_;
162
163 # Extract the content of the sequence.
164 my $content = $pod_seq->raw_text();
165 $content = substr $content, 0, - length $pod_seq->right_delimiter();
166 $content = substr $content, length( $pod_seq->cmd_name() ) + length(
167 $pod_seq->left_delimiter() );
168
169 # Not interested in hyperlinks.
170 $content =~ m{ \A \w+ : (?! : ) }smx
171 and return $TRUE;
172
173 # Links with text specified are good.
174 $content =~ m/ [|] /smx
175 and return $TRUE;
176
177 # Internal sections without text are either good or bad, depending on how
178 # we are configured.
179 $content =~ m{ \A [/"] }smx
180 and return $self->{_allow_internal_sections};
181
182 # External sections without text are either good or bad, depending on how
183 # we are configured.
184 $content =~ m{ / }smx
185 and return $self->{_allow_external_sections};
186
187 # Anything else without text is bad.
188 return $FALSE;
189}
190
19118µs1;
192
193__END__