← 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:10 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Critic/Command.pm
StatementsExecuted 2556 statements in 12.9ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1116.86ms10.7msPerl::Critic::Command::::BEGIN@17Perl::Critic::Command::BEGIN@17
1112.78ms41.6msPerl::Critic::Command::::BEGIN@19Perl::Critic::Command::BEGIN@19
1112.75ms34.3sPerl::Critic::Command::::_critiquePerl::Critic::Command::_critique
288112.43ms2.43msPerl::Critic::Command::::CORE:printPerl::Critic::Command::CORE:print (opcode)
1112.38ms2.70msPerl::Critic::Command::::BEGIN@15Perl::Critic::Command::BEGIN@15
288212.05ms4.48msPerl::Critic::Command::::_outPerl::Critic::Command::_out
1111.90ms13.0msPerl::Critic::Command::::BEGIN@27Perl::Critic::Command::BEGIN@27
144111.90ms6.38msPerl::Critic::Command::::_render_reportPerl::Critic::Command::_render_report
111645µs5.36msPerl::Critic::Command::::BEGIN@14Perl::Critic::Command::BEGIN@14
111406µs926µsPerl::Critic::Command::::BEGIN@26Perl::Critic::Command::BEGIN@26
111307µs76.3msPerl::Critic::Command::::BEGIN@21Perl::Critic::Command::BEGIN@21
111276µs671µsPerl::Critic::Command::::BEGIN@18Perl::Critic::Command::BEGIN@18
11174µs2.06msPerl::Critic::Command::::_get_optionsPerl::Critic::Command::_get_options
11161µs34.3sPerl::Critic::Command::::runPerl::Critic::Command::run
11137µs1.92msPerl::Critic::Command::::_parse_command_linePerl::Critic::Command::_parse_command_line
11122µs11.0msPerl::Critic::Command::::_get_inputPerl::Critic::Command::_get_input
11117µs17µsPerl::Critic::Command::::BEGIN@10Perl::Critic::Command::BEGIN@10
11114µs14µsPerl::Critic::Command::::CORE:ftisPerl::Critic::Command::CORE:ftis (opcode)
11111µs19µsPerl::Critic::Command::::BEGIN@35Perl::Critic::Command::BEGIN@35
11111µs13µsPerl::Critic::Command::::_validate_optionsPerl::Critic::Command::_validate_options
11110µs10µsPerl::Critic::Command::::_get_option_specificationPerl::Critic::Command::_get_option_specification
1118µs380µsPerl::Critic::Command::::BEGIN@22Perl::Critic::Command::BEGIN@22
1117µs11µsPerl::Critic::Command::::BEGIN@12Perl::Critic::Command::BEGIN@12
1117µs22µsPerl::Critic::Command::::BEGIN@11Perl::Critic::Command::BEGIN@11
1116µs6µsPerl::Critic::Command::::_dispatch_special_requestsPerl::Critic::Command::_dispatch_special_requests
1114µs4µsPerl::Critic::Command::::CORE:ftdirPerl::Critic::Command::CORE:ftdir (opcode)
1113µs3µsPerl::Critic::Command::::_set_up_pagerPerl::Critic::Command::_set_up_pager
0000s0sPerl::Critic::Command::::__ANON__[:211]Perl::Critic::Command::__ANON__[:211]
0000s0sPerl::Critic::Command::::__ANON__[:92]Perl::Critic::Command::__ANON__[:92]
0000s0sPerl::Critic::Command::::__ANON__[:93]Perl::Critic::Command::__ANON__[:93]
0000s0sPerl::Critic::Command::::_at_ttyPerl::Critic::Command::_at_tty
0000s0sPerl::Critic::Command::::_colorizePerl::Critic::Command::_colorize
0000s0sPerl::Critic::Command::::_colorize_by_severityPerl::Critic::Command::_colorize_by_severity
0000s0sPerl::Critic::Command::::_commaifyPerl::Critic::Command::_commaify
0000s0sPerl::Critic::Command::::_display_versionPerl::Critic::Command::_display_version
0000s0sPerl::Critic::Command::::_render_all_policy_listingPerl::Critic::Command::_render_all_policy_listing
0000s0sPerl::Critic::Command::::_render_policy_docsPerl::Critic::Command::_render_policy_docs
0000s0sPerl::Critic::Command::::_render_policy_listingPerl::Critic::Command::_render_policy_listing
0000s0sPerl::Critic::Command::::_render_profile_prototypePerl::Critic::Command::_render_profile_prototype
0000s0sPerl::Critic::Command::::_render_theme_listingPerl::Critic::Command::_render_theme_listing
0000s0sPerl::Critic::Command::::_report_statisticsPerl::Critic::Command::_report_statistics
0000s0sPerl::Critic::Command::::_this_is_windowsPerl::Critic::Command::_this_is_windows
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::Command;
9
10241µs117µs
# spent 17µs within Perl::Critic::Command::BEGIN@10 which was called: # once (17µs+0s) by main::BEGIN@19 at line 10
use 5.006001;
# spent 17µs making 1 call to Perl::Critic::Command::BEGIN@10
11221µs236µs
# spent 22µs (7+14) within Perl::Critic::Command::BEGIN@11 which was called: # once (7µs+14µs) by main::BEGIN@19 at line 11
use strict;
# spent 22µs making 1 call to Perl::Critic::Command::BEGIN@11 # spent 14µs making 1 call to strict::import
12222µs215µs
# spent 11µs (7+4) within Perl::Critic::Command::BEGIN@12 which was called: # once (7µs+4µs) by main::BEGIN@19 at line 12
use warnings;
# spent 11µs making 1 call to Perl::Critic::Command::BEGIN@12 # spent 4µs making 1 call to warnings::import
13
142132µs27.02ms
# spent 5.36ms (645µs+4.71) within Perl::Critic::Command::BEGIN@14 which was called: # once (645µs+4.71ms) by main::BEGIN@19 at line 14
use English qw< -no_match_vars >;
# spent 5.36ms making 1 call to Perl::Critic::Command::BEGIN@14 # spent 1.66ms making 1 call to English::import
152107µs22.76ms
# spent 2.70ms (2.38+319µs) within Perl::Critic::Command::BEGIN@15 which was called: # once (2.38ms+319µs) by main::BEGIN@19 at line 15
use Readonly;
# spent 2.70ms making 1 call to Perl::Critic::Command::BEGIN@15 # spent 53µs making 1 call to Exporter::import
16
172124µs210.8ms
# spent 10.7ms (6.86+3.83) within Perl::Critic::Command::BEGIN@17 which was called: # once (6.86ms+3.83ms) by main::BEGIN@19 at line 17
use Getopt::Long qw< GetOptions >;
# spent 10.7ms making 1 call to Perl::Critic::Command::BEGIN@17 # spent 121µs making 1 call to Getopt::Long::import
18298µs2678µs
# spent 671µs (276+395) within Perl::Critic::Command::BEGIN@18 which was called: # once (276µs+395µs) by main::BEGIN@19 at line 18
use List::Util qw< first max >;
# spent 671µs making 1 call to Perl::Critic::Command::BEGIN@18 # spent 7µs making 1 call to List::Util::import
192117µs241.7ms
# spent 41.6ms (2.78+38.9) within Perl::Critic::Command::BEGIN@19 which was called: # once (2.78ms+38.9ms) by main::BEGIN@19 at line 19
use Pod::Usage qw< pod2usage >;
# spent 41.6ms making 1 call to Perl::Critic::Command::BEGIN@19 # spent 40µs making 1 call to Exporter::import
20
212112µs176.3ms
# spent 76.3ms (307µs+76.0) within Perl::Critic::Command::BEGIN@21 which was called: # once (307µs+76.0ms) by main::BEGIN@19 at line 21
use Perl::Critic::Exception::Parse ();
# spent 76.3ms making 1 call to Perl::Critic::Command::BEGIN@21
221300ns
# spent 380µs (8+372) within Perl::Critic::Command::BEGIN@22 which was called: # once (8µs+372µs) by main::BEGIN@19 at line 25
use Perl::Critic::Utils qw<
23 :characters :severities policy_short_name
24 $DEFAULT_VERBOSITY $DEFAULT_VERBOSITY_WITH_FILE_NAME
25126µs2752µs>;
# spent 380µs making 1 call to Perl::Critic::Command::BEGIN@22 # spent 372µs making 1 call to Exporter::import
26298µs21.01ms
# spent 926µs (406+520) within Perl::Critic::Command::BEGIN@26 which was called: # once (406µs+520µs) by main::BEGIN@19 at line 26
use Perl::Critic::Utils::Constants qw< $_MODULE_VERSION_TERM_ANSICOLOR >;
# spent 926µs making 1 call to Perl::Critic::Command::BEGIN@26 # spent 86µs making 1 call to Exporter::import
272110µs113.0ms
# spent 13.0ms (1.90+11.1) within Perl::Critic::Command::BEGIN@27 which was called: # once (1.90ms+11.1ms) by main::BEGIN@19 at line 27
use Perl::Critic::Violation qw<>;
# spent 13.0ms making 1 call to Perl::Critic::Command::BEGIN@27
28
29#-----------------------------------------------------------------------------
30
311900nsour $VERSION = '1.121';
32
33#-----------------------------------------------------------------------------
34
3523.17ms227µs
# spent 19µs (11+8) within Perl::Critic::Command::BEGIN@35 which was called: # once (11µs+8µs) by main::BEGIN@19 at line 35
use Exporter 'import';
# spent 19µs making 1 call to Perl::Critic::Command::BEGIN@35 # spent 8µs making 1 call to Exporter::import
36
3714µs138µsReadonly::Array our @EXPORT_OK => qw< run >;
# spent 38µs making 1 call to Readonly::Array
38
39110µs368µsReadonly::Hash our %EXPORT_TAGS => (
# spent 64µs making 1 call to Readonly::Hash # spent 2µs making 1 call to Readonly::Array::FETCH # spent 2µs making 1 call to Readonly::Array::FETCHSIZE
40 all => [ @EXPORT_OK ],
41);
42
43#-----------------------------------------------------------------------------
44
4512µs132µsReadonly::Scalar my $DEFAULT_VIOLATIONS_FOR_TOP => 20;
# spent 32µs making 1 call to Readonly::Scalar
46
4711µs128µsReadonly::Scalar my $EXIT_SUCCESS => 0;
# spent 28µs making 1 call to Readonly::Scalar
4811µs127µsReadonly::Scalar my $EXIT_NO_FILES => 1;
# spent 27µs making 1 call to Readonly::Scalar
4911µs126µsReadonly::Scalar my $EXIT_HAD_VIOLATIONS => 2;
# spent 26µs making 1 call to Readonly::Scalar
5011µs126µsReadonly::Scalar my $EXIT_HAD_FILE_PROBLEMS => 3;
# spent 26µs making 1 call to Readonly::Scalar
51
52#-----------------------------------------------------------------------------
53
541400nsmy @files = ();
551200nsmy $critic = undef;
561400nsmy $output = \*STDOUT;
57
58#-----------------------------------------------------------------------------
59
60
# spent 4.48ms (2.05+2.43) within Perl::Critic::Command::_out which was called 288 times, avg 16µs/call: # 144 times (1.05ms+1.98ms) by Perl::Critic::Command::_render_report at line 308, avg 21µs/call # 144 times (1.00ms+444µs) by Perl::Critic::Command::_render_report at line 309, avg 10µs/call
sub _out {
61288213µs my @lines = @_;
622884.44ms2882.43ms return print {$output} @lines;
# spent 2.43ms making 288 calls to Perl::Critic::Command::CORE:print, avg 8µs/call
63}
64
65#-----------------------------------------------------------------------------
66
67
# spent 34.3s (61µs+34.3) within Perl::Critic::Command::run which was called: # once (61µs+34.3s) by main::RUNTIME at line 30 of /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
sub run {
6812µs12.06ms my %options = _get_options();
# spent 2.06ms making 1 call to Perl::Critic::Command::_get_options
69111µs111.0ms @files = _get_input(@ARGV);
# spent 11.0ms making 1 call to Perl::Critic::Command::_get_input
70
7118µs134.3s my ($violations, $had_error_in_file) = _critique(\%options, @files);
# spent 34.3s making 1 call to Perl::Critic::Command::_critique
72
731200ns return $EXIT_HAD_FILE_PROBLEMS if $had_error_in_file;
741100ns return $EXIT_NO_FILES if not defined $violations;
7510s return $EXIT_HAD_VIOLATIONS if $violations;
76
77131µs return $EXIT_SUCCESS;
78}
79
80#-----------------------------------------------------------------------------
81
82
# spent 2.06ms (74µs+1.98) within Perl::Critic::Command::_get_options which was called: # once (74µs+1.98ms) by Perl::Critic::Command::run at line 68
sub _get_options {
83
8411µs11.92ms my %opts = _parse_command_line();
# spent 1.92ms making 1 call to Perl::Critic::Command::_parse_command_line
8512µs16µs _dispatch_special_requests( %opts );
# spent 6µs making 1 call to Perl::Critic::Command::_dispatch_special_requests
8611µs113µs _validate_options( %opts );
# spent 13µs making 1 call to Perl::Critic::Command::_validate_options
87
88 # Convert severity shortcut options. If multiple shortcuts
89 # are given, the lowest one wins. If an explicit --severity
90 # option has been given, then the shortcuts are ignored. The
91 # @SEVERITY_NAMES variable is exported by Perl::Critic::Utils.
92652µs737µs $opts{-severity} ||= first { exists $opts{"-$_"} } @SEVERITY_NAMES;
# spent 26µs making 1 call to List::Util::first # spent 9µs making 5 calls to Readonly::Array::FETCH, avg 2µs/call # spent 2µs making 1 call to Readonly::Array::FETCHSIZE
93617µs38µs $opts{-severity} ||= first { exists $opts{"-$_"} } ($SEVERITY_LOWEST .. $SEVERITY_HIGHEST);
# spent 5µs making 1 call to List::Util::first # spent 3µs making 2 calls to Readonly::Scalar::FETCH, avg 2µs/call
94
95
96 # If --top is specified, default the severity level to 1, unless an
97 # explicit severity is defined. This provides us flexibility to
98 # report top-offenders across just some or all of the severity levels.
99 # We also default the --top count to twenty if none is given
1001700ns if ( exists $opts{-top} ) {
101 $opts{-severity} ||= 1;
102 $opts{-top} ||= $DEFAULT_VIOLATIONS_FOR_TOP;
103 }
104
105 #Override profile, if --noprofile is specified
1061400ns if ( exists $opts{-noprofile} ) {
107 $opts{-profile} = $EMPTY;
108 }
109
11015µs return %opts;
111}
112
113#-----------------------------------------------------------------------------
114
115
# spent 1.92ms (37µs+1.88) within Perl::Critic::Command::_parse_command_line which was called: # once (37µs+1.88ms) by Perl::Critic::Command::_get_options at line 84
sub _parse_command_line {
1161200ns my %opts;
11716µs110µs my @opt_specs = _get_option_specification();
# spent 10µs making 1 call to Perl::Critic::Command::_get_option_specification
11812µs135µs Getopt::Long::Configure('no_ignore_case');
# spent 35µs making 1 call to Getopt::Long::Configure
11918µs111µs GetOptions( \%opts, @opt_specs ) || pod2usage(); #Exits
# spent 11µs making 1 call to Getopt::Long::GetOptions
120
121 # I've adopted the convention of using key-value pairs for
122 # arguments to most functions. And to increase legibility,
123 # I have also adopted the familiar command-line practice
124 # of denoting argument names with a leading dash (-).
12511µs my %dashed_opts = map { ( "-$_" => $opts{$_} ) } keys %opts;
126111µs return %dashed_opts;
127}
128
129#-----------------------------------------------------------------------------
130
131
# spent 6µs within Perl::Critic::Command::_dispatch_special_requests which was called: # once (6µs+0s) by Perl::Critic::Command::_get_options at line 85
sub _dispatch_special_requests {
1321400ns my (%opts) = @_;
1331700ns if ( $opts{-help} ) { pod2usage( -verbose => 0 ) } # Exits
1341300ns if ( $opts{-options} ) { pod2usage( -verbose => 1 ) } # Exits
1351300ns if ( $opts{-man} ) { pod2usage( -verbose => 2 ) } # Exits
1361400ns if ( $opts{-version} ) { _display_version() } # Exits
1371300ns if ( $opts{-list} ) { _render_all_policy_listing() } # Exits
1381100ns if ( $opts{'-list-enabled'} ) { _render_policy_listing(%opts) } # Exits
1391100ns if ( $opts{'-list-themes'} ) { _render_theme_listing() } # Exits
1401100ns if ( $opts{'-profile-proto'} ) { _render_profile_prototype() } # Exits
1411300ns if ( $opts{-doc} ) { _render_policy_docs( %opts ) } # Exits
14214µs return 1;
143}
144
145#-----------------------------------------------------------------------------
146
147
# spent 13µs (11+2) within Perl::Critic::Command::_validate_options which was called: # once (11µs+2µs) by Perl::Critic::Command::_get_options at line 86
sub _validate_options {
1481300ns my (%opts) = @_;
14914µs12µs my $msg = $EMPTY;
# spent 2µs making 1 call to Readonly::Scalar::FETCH
150
151
1521500ns if ( $opts{-noprofile} && $opts{-profile} ) {
153 $msg .= qq{Warning: Cannot use -noprofile with -profile option.\n};
154 }
155
1561200ns if ( $opts{-verbose} && $opts{-verbose} !~ m{(?: \d+ | %[mfFlcCedrpPs] )}xms) {
157 $msg .= qq<Warning: --verbose arg "$opts{-verbose}" looks odd. >;
158 $msg .= qq<Perhaps you meant to say "--verbose 3 $opts{-verbose}."\n>;
159 }
160
1611400ns if ( exists $opts{-top} && $opts{-top} < 0 ) {
162 $msg .= qq<Warning: --top argument "$opts{-top}" is negative. >;
163 $msg .= qq<Perhaps you meant to say "$opts{-top} --top".\n>;
164 }
165
1661300ns if (
167 exists $opts{-severity}
168 && (
169 $opts{-severity} < $SEVERITY_LOWEST
170 || $opts{-severity} > $SEVERITY_HIGHEST
171 )
172 ) {
173 $msg .= qq<Warning: --severity arg "$opts{-severity}" out of range. >;
174 $msg .= qq<Severities range from "$SEVERITY_LOWEST" (lowest) to >;
175 $msg .= qq<"$SEVERITY_HIGHEST" (highest).\n>;
176 }
177
178
1791100ns if ( $msg ) {
180 pod2usage( -exitstatus => 1, -message => $msg, -verbose => 0); #Exits
181 }
182
183
18414µs return 1;
185}
186
187#-----------------------------------------------------------------------------
188
189
# spent 11.0ms (22µs+10.9) within Perl::Critic::Command::_get_input which was called: # once (22µs+10.9ms) by Perl::Critic::Command::run at line 69
sub _get_input {
190
1911900ns my @args = @_;
192
1931900ns if ( !@args || (@args == 1 && $args[0] eq q{-}) ) {
194
195 # Reading code from STDIN. All the code is slurped into
196 # a string. PPI will barf if the string is just whitespace.
197 my $code_string = do { local $RS = undef; <STDIN> };
198
199 # Notice if STDIN was closed (pipe error, etc)
200 if ( ! defined $code_string ) {
201 $code_string = $EMPTY;
202 }
203
204 $code_string =~ m{ \S+ }xms || die qq{Nothing to critique.\n};
205 return \$code_string; #Convert to SCALAR ref for PPI
206 }
207 else {
208
209 # Test to make sure all the specified files or directories
210 # actually exist. If any one of them is bogus, then die.
211229µs237µs if ( my $nonexistent = first { ! -e $_ } @args ) {
# spent 23µs making 1 call to List::Util::first # spent 14µs making 1 call to Perl::Critic::Command::CORE:ftis
212 my $msg = qq{No such file or directory: '$nonexistent'};
213 pod2usage( -exitstatus => 1, -message => $msg, -verbose => 0);
214 }
215
216 # Reading code from files or dirs. If argument is a file,
217 # then we process it as-is (even though it may not actually
218 # be Perl code). If argument is a directory, recursively
219 # search the directory for files that look like Perl code.
220217µs210.9ms return map { -d $_ ? Perl::Critic::Utils::all_perl_files($_) : $_ } @args;
# spent 10.9ms making 1 call to Perl::Critic::Utils::all_perl_files # spent 4µs making 1 call to Perl::Critic::Command::CORE:ftdir
221 }
222}
223
224#------------------------------------------------------------------------------
225
226
# spent 34.3s (2.75ms+34.3) within Perl::Critic::Command::_critique which was called: # once (2.75ms+34.3s) by Perl::Critic::Command::run at line 71
sub _critique {
227
228122µs my ( $opts_ref, @files_to_critique ) = @_;
2291200ns @files_to_critique || die "No perl files were found.\n";
230
231 # Perl::Critic has lots of dependencies, so loading is delayed
232 # until it is really needed. This hack reduces startup time for
233 # doing other things like getting the version number or dumping
234 # the man page. Arguably, those things are pretty rare, but hey,
235 # why not save a few seconds if you can.
236
237187µs require Perl::Critic;
23815µs1426ms $critic = Perl::Critic->new( %{$opts_ref} );
# spent 426ms making 1 call to Perl::Critic::new
23913µs115µs $critic->policies() || die "No policies selected.\n";
# spent 15µs making 1 call to Perl::Critic::policies
240
24117µs37µs _set_up_pager($critic->config()->pager());
# spent 3µs making 1 call to Perl::Critic::Command::_set_up_pager # spent 3µs making 1 call to Perl::Critic::Config::pager # spent 1µs making 1 call to Perl::Critic::config
242
2431400ns my $number_of_violations = undef;
2441500ns my $had_error_in_file = 0;
245
246115µs for my $file (@files_to_critique) {
247
248 eval {
2491441.19ms28833.4s my @violations = $critic->critique($file);
# spent 32.4s making 144 calls to Perl::Critic::critique, avg 225ms/call # spent 999ms making 144 calls to PPI::Node::DESTROY, avg 6.94ms/call
25014485µs $number_of_violations += scalar @violations;
251
252144459µs1446.38ms if (not $opts_ref->{'-statistics-only'}) {
# spent 6.38ms making 144 calls to Perl::Critic::Command::_render_report, avg 44µs/call
253 _render_report( $file, $opts_ref, @violations )
254 }
255144125µs 1;
256 }
257144156µs or do {
258 if ( my $exception = Perl::Critic::Exception::Parse->caught() ) {
259 $had_error_in_file = 1;
260 warn qq<Problem while critiquing "$file": $EVAL_ERROR\n>;
261 }
262 elsif ($EVAL_ERROR) {
263 # P::C::Exception::Fatal includes the stack trace in its
264 # stringification.
265 die qq<Fatal error while critiquing "$file": $EVAL_ERROR\n>;
266 }
267 else {
268 die qq<Fatal error while critiquing "$file". Unfortunately, >,
269 q<$@/$EVAL_ERROR >, ## no critic (RequireInterpolationOfMetachars)
270 qq<is empty, so the reason can't be shown.\n>;
271 }
272 }
273 }
274
27511µs if ( $opts_ref->{-statistics} or $opts_ref->{'-statistics-only'} ) {
276 my $stats = $critic->statistics();
277 _report_statistics( $opts_ref, $stats );
278 }
279
280130µs return $number_of_violations, $had_error_in_file;
281}
282
283#------------------------------------------------------------------------------
284
285
# spent 6.38ms (1.90+4.48) within Perl::Critic::Command::_render_report which was called 144 times, avg 44µs/call: # 144 times (1.90ms+4.48ms) by Perl::Critic::Command::_critique at line 252, avg 44µs/call
sub _render_report {
286144139µs my ( $file, $opts_ref, @violations ) = @_;
287
288 # Only report the files, if asked.
28914474µs my $number_of_violations = scalar @violations;
290144115µs if ( $opts_ref->{'-files-with-violations'} ||
291 $opts_ref->{'-files-without-violations'} ) {
292 not ref $file
293 and $opts_ref->{$number_of_violations ? '-files-with-violations' :
294 '-files-without-violations'}
295 and _out "$file\n";
296 return $number_of_violations;
297 }
298
299 # Only report the number of violations, if asked.
300144181µs if( $opts_ref->{-count} ){
301 ref $file || _out "$file: ";
302 _out "$number_of_violations\n";
303 return $number_of_violations;
304 }
305
306 # Hail all-clear unless we should shut up.
307144142µs if( !@violations && !$opts_ref->{-quiet} ) {
308144350µs1443.03ms ref $file || _out "$file ";
# spent 3.03ms making 144 calls to Perl::Critic::Command::_out, avg 21µs/call
309144208µs1441.45ms _out "source OK\n";
# spent 1.45ms making 144 calls to Perl::Critic::Command::_out, avg 10µs/call
310144421µs return 0;
311 }
312
313 # Otherwise, format and print violations
314 my $verbosity = $critic->config->verbose();
315 # $verbosity can be numeric or string, so use "eq" for comparison;
316 $verbosity =
317 ($verbosity eq $DEFAULT_VERBOSITY && @files > 1)
318 ? $DEFAULT_VERBOSITY_WITH_FILE_NAME
319 : $verbosity;
320 my $fmt = Perl::Critic::Utils::verbosity_to_format( $verbosity );
321 if (not -f $file) { $fmt =~ s< \%[fF] ><STDIN>xms; } #HACK!
322 Perl::Critic::Violation::set_format( $fmt );
323
324 my $color = $critic->config->color();
325 _out $color ? _colorize_by_severity(@violations) : @violations;
326
327 return $number_of_violations;
328}
329
330#-----------------------------------------------------------------------------
331
332
# spent 3µs within Perl::Critic::Command::_set_up_pager which was called: # once (3µs+0s) by Perl::Critic::Command::_critique at line 241
sub _set_up_pager {
3331500ns my ($pager_command) = @_;
33413µs return if not $pager_command;
335 return if not _at_tty();
336
337 open my $pager, q<|->, $pager_command ## no critic (InputOutput::RequireBriefOpen)
338 or die qq<Unable to pipe to pager "$pager_command": $ERRNO\n>;
339
340 $output = $pager;
341
342 return;
343}
344
345#-----------------------------------------------------------------------------
346
347sub _report_statistics {
348 my ($opts_ref, $statistics) = @_;
349
350 if (
351 not $opts_ref->{'-statistics-only'}
352 and (
353 $statistics->total_violations()
354 or not $opts_ref->{-quiet} and $statistics->modules()
355 )
356 ) {
357 _out "\n"; # There's prior output that we want to separate from.
358 }
359
360 my $files = _commaify($statistics->modules());
361 my $subroutines = _commaify($statistics->subs());
362 my $statements = _commaify($statistics->statements_other_than_subs());
363 my $lines = _commaify($statistics->lines());
364 my $width = max map { length } $files, $subroutines, $statements;
365
366 _out sprintf "%*s %s.\n", $width, $files, 'files';
367 _out sprintf "%*s %s.\n", $width, $subroutines, 'subroutines/methods';
368 _out sprintf "%*s %s.\n", $width, $statements, 'statements';
369
370 my $lines_of_blank = _commaify( $statistics->lines_of_blank() );
371 my $lines_of_comment = _commaify( $statistics->lines_of_comment() );
372 my $lines_of_data = _commaify( $statistics->lines_of_data() );
373 my $lines_of_perl = _commaify( $statistics->lines_of_perl() );
374 my $lines_of_pod = _commaify( $statistics->lines_of_pod() );
375
376 $width =
377 max map { length }
378 $lines_of_blank, $lines_of_comment, $lines_of_data,
379 $lines_of_perl, $lines_of_pod;
380 _out sprintf "\n%s %s:\n", $lines, 'lines, consisting of';
381 _out sprintf " %*s %s.\n", $width, $lines_of_blank, 'blank lines';
382 _out sprintf " %*s %s.\n", $width, $lines_of_comment, 'comment lines';
383 _out sprintf " %*s %s.\n", $width, $lines_of_data, 'data lines';
384 _out sprintf " %*s %s.\n", $width, $lines_of_perl, 'lines of Perl code';
385 _out sprintf " %*s %s.\n", $width, $lines_of_pod, 'lines of POD';
386
387 my $average_sub_mccabe = $statistics->average_sub_mccabe();
388 if (defined $average_sub_mccabe) {
389 _out
390 sprintf
391 "\nAverage McCabe score of subroutines was %.2f.\n",
392 $average_sub_mccabe;
393 }
394
395 _out "\n";
396
397 _out _commaify($statistics->total_violations()), " violations.\n";
398
399 my $violations_per_file = $statistics->violations_per_file();
400 if (defined $violations_per_file) {
401 _out
402 sprintf
403 "Violations per file was %.3f.\n",
404 $violations_per_file;
405 }
406 my $violations_per_statement = $statistics->violations_per_statement();
407 if (defined $violations_per_statement) {
408 _out
409 sprintf
410 "Violations per statement was %.3f.\n",
411 $violations_per_statement;
412 }
413 my $violations_per_line = $statistics->violations_per_line_of_code();
414 if (defined $violations_per_line) {
415 _out
416 sprintf
417 "Violations per line of code was %.3f.\n",
418 $violations_per_line;
419 }
420
421 if ( $statistics->total_violations() ) {
422 _out "\n";
423
424 my %severity_violations = %{ $statistics->violations_by_severity() };
425 my @severities = reverse sort keys %severity_violations;
426 $width =
427 max
428 map { length _commaify( $severity_violations{$_} ) }
429 @severities;
430 foreach my $severity (@severities) {
431 _out
432 sprintf
433 "%*s severity %d violations.\n",
434 $width,
435 _commaify( $severity_violations{$severity} ),
436 $severity;
437 }
438
439 _out "\n";
440
441 my %policy_violations = %{ $statistics->violations_by_policy() };
442 my @policies = sort keys %policy_violations;
443 $width =
444 max
445 map { length _commaify( $policy_violations{$_} ) }
446 @policies;
447 foreach my $policy (@policies) {
448 _out
449 sprintf
450 "%*s violations of %s.\n",
451 $width,
452 _commaify($policy_violations{$policy}),
453 policy_short_name($policy);
454 }
455 }
456
457 return;
458}
459
460#-----------------------------------------------------------------------------
461
462# Only works for integers.
463sub _commaify {
464 my ( $number ) = @_;
465
466 while ($number =~ s/ \A ( [-+]? \d+ ) ( \d{3} ) /$1,$2/xms) {
467 # nothing
468 }
469
470 return $number;
471}
472
473#-----------------------------------------------------------------------------
474
475
# spent 10µs within Perl::Critic::Command::_get_option_specification which was called: # once (10µs+0s) by Perl::Critic::Command::_parse_command_line at line 117
sub _get_option_specification {
476
477116µs return qw<
478 5 4 3 2 1
479 Safari
480 version
481 brutal
482 count|C
483 cruel
484 doc=s
485 exclude=s@
486 force!
487 gentle
488 harsh
489 help|?|H
490 include=s@
491 list
492 list-enabled
493 list-themes
494 man
495 color|colour!
496 noprofile
497 only!
498 options
499 pager=s
500 profile|p=s
501 profile-proto
502 quiet
503 severity=i
504 single-policy|s=s
505 stern
506 statistics!
507 statistics-only!
508 profile-strictness=s
509 theme=s
510 top:i
511 allow-unsafe
512 verbose=s
513 color-severity-highest|colour-severity-highest|color-severity-5|colour-severity-5=s
514 color-severity-high|colour-severity-high|color-severity-4|colour-severity-4=s
515 color-severity-medium|colour-severity-medium|color-severity-3|colour-severity-3=s
516 color-severity-low|colour-severity-low|color-severity-2|colour-severity-2=s
517 color-severity-lowest|colour-severity-lowest|color-severity-1|colour-severity-1=s
518 files-with-violations|l
519 files-without-violations|L
520 program-extensions=s@
521 >;
522}
523
524#-----------------------------------------------------------------------------
525
526sub _colorize_by_severity {
527 my @violations = @_;
528 return @violations if _this_is_windows();
529 return @violations if not eval {
530 require Term::ANSIColor;
531 Term::ANSIColor->VERSION( $_MODULE_VERSION_TERM_ANSICOLOR );
532 1;
533 };
534
535 my $config = $critic->config();
536 my %color_of = (
537 $SEVERITY_HIGHEST => $config->color_severity_highest(),
538 $SEVERITY_HIGH => $config->color_severity_high(),
539 $SEVERITY_MEDIUM => $config->color_severity_medium(),
540 $SEVERITY_LOW => $config->color_severity_low(),
541 $SEVERITY_LOWEST => $config->color_severity_lowest(),
542 );
543
544 return map { _colorize( "$_", $color_of{$_->severity()} ) } @violations;
545
546}
547
548#-----------------------------------------------------------------------------
549
550sub _colorize {
551 my ($string, $color) = @_;
552 return $string if not defined $color;
553 return $string if $color eq $EMPTY;
554 # $terminator is a purely cosmetic change to make the color end at the end
555 # of the line rather than right before the next line. It is here because
556 # if you use background colors, some console windows display a little
557 # fragment of colored background before the next uncolored (or
558 # differently-colored) line.
559 my $terminator = chomp $string ? "\n" : $EMPTY;
560 return Term::ANSIColor::colored( $string, $color ) . $terminator;
561}
562
563#-----------------------------------------------------------------------------
564
565sub _this_is_windows {
566 return 1 if $OSNAME =~ m/MSWin32/xms;
567 return 0;
568}
569
570#-----------------------------------------------------------------------------
571
572sub _at_tty {
573 return -t STDOUT; ## no critic (ProhibitInteractiveTest);
574}
575
576#-----------------------------------------------------------------------------
577
578sub _render_all_policy_listing {
579 # Force P-C parameters, to catch all Policies on this site
580 my %pc_params = (-profile => $EMPTY, -severity => $SEVERITY_LOWEST);
581 return _render_policy_listing( %pc_params );
582}
583
584#-----------------------------------------------------------------------------
585
586sub _render_policy_listing {
587 my %pc_params = @_;
588
589 require Perl::Critic::PolicyListing;
590 require Perl::Critic;
591
592 my @policies = Perl::Critic->new( %pc_params )->policies();
593 my $listing = Perl::Critic::PolicyListing->new( -policies => \@policies );
594 _out $listing;
595
596 exit $EXIT_SUCCESS;
597}
598
599#-----------------------------------------------------------------------------
600
601sub _render_theme_listing {
602
603 require Perl::Critic::ThemeListing;
604 require Perl::Critic;
605
606 my %pc_params = (-profile => $EMPTY, -severity => $SEVERITY_LOWEST);
607 my @policies = Perl::Critic->new( %pc_params )->policies();
608 my $listing = Perl::Critic::ThemeListing->new( -policies => \@policies );
609 _out $listing;
610
611 exit $EXIT_SUCCESS;
612}
613
614#-----------------------------------------------------------------------------
615
616sub _render_profile_prototype {
617
618 require Perl::Critic::ProfilePrototype;
619 require Perl::Critic;
620
621 my %pc_params = (-profile => $EMPTY, -severity => $SEVERITY_LOWEST);
622 my @policies = Perl::Critic->new( %pc_params )->policies();
623 my $prototype = Perl::Critic::ProfilePrototype->new( -policies => \@policies );
624 _out $prototype;
625
626 exit $EXIT_SUCCESS;
627}
628
629#-----------------------------------------------------------------------------
630
631sub _render_policy_docs {
632
633 my (%opts) = @_;
634 my $pattern = delete $opts{-doc};
635
636 require Perl::Critic;
637 $critic = Perl::Critic->new(%opts);
638 _set_up_pager($critic->config()->pager());
639
640 require Perl::Critic::PolicyFactory;
641 my @site_policies = Perl::Critic::PolicyFactory->site_policy_names();
642 my @matching_policies = grep { $_ =~ m/$pattern/ixms } @site_policies;
643
644 # "-T" means don't send to pager
645 my @perldoc_output = map {`perldoc -T $_`} @matching_policies; ## no critic (ProhibitBacktick)
646 _out @perldoc_output;
647
648 exit $EXIT_SUCCESS;
649}
650
651#-----------------------------------------------------------------------------
652
653sub _display_version {
654 _out "$VERSION\n";
655 exit $EXIT_SUCCESS;
656}
657
658#-----------------------------------------------------------------------------
65918µs1;
660
661__END__
 
# spent 4µs within Perl::Critic::Command::CORE:ftdir which was called: # once (4µs+0s) by Perl::Critic::Command::_get_input at line 220
sub Perl::Critic::Command::CORE:ftdir; # opcode
# spent 14µs within Perl::Critic::Command::CORE:ftis which was called: # once (14µs+0s) by List::Util::first at line 211
sub Perl::Critic::Command::CORE:ftis; # opcode
# spent 2.43ms within Perl::Critic::Command::CORE:print which was called 288 times, avg 8µs/call: # 288 times (2.43ms+0s) by Perl::Critic::Command::_out at line 62, avg 8µs/call
sub Perl::Critic::Command::CORE:print; # opcode
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.