Login
First attempt to warn users when they have an unecessary "## no critic"
[gknop/Perl-Critic.git] / lib / Perl / Critic / OptionsProcessor.pm
CommitLineData
dc93df4f
JRT
1##############################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
dc93df4f
JRT
6##############################################################################
7
894d344a 8package Perl::Critic::OptionsProcessor;
dc93df4f 9
df6dee2b 10use 5.006001;
dc93df4f
JRT
11use strict;
12use warnings;
ee5a2bbd 13
dc93df4f 14use English qw(-no_match_vars);
ee5a2bbd 15
ee5a2bbd
ES
16use Perl::Critic::Exception::AggregateConfiguration;
17use Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter;
e424327a
ES
18use Perl::Critic::Utils qw<
19 :booleans :characters :severities :data_conversion $DEFAULT_VERBOSITY
20>;
21use Perl::Critic::Utils::Constants qw< $PROFILE_STRICTNESS_DEFAULT >;
22use Perl::Critic::Utils::DataConversion qw< dor >;
dc93df4f 23
173667ce 24our $VERSION = '1.093_01';
dc93df4f
JRT
25
26#-----------------------------------------------------------------------------
27
28sub new {
dc93df4f
JRT
29 my ($class, %args) = @_;
30 my $self = bless {}, $class;
31 $self->_init( %args );
32 return $self;
33}
34
35#-----------------------------------------------------------------------------
36
37sub _init {
dc93df4f
JRT
38 my ( $self, %args ) = @_;
39
40 # Multi-value defaults
e424327a 41 my $exclude = dor(delete $args{exclude}, $EMPTY);
6a51d540 42 $self->{_exclude} = [ words_from_string( $exclude ) ];
e424327a 43 my $include = dor(delete $args{include}, $EMPTY);
6a51d540 44 $self->{_include} = [ words_from_string( $include ) ];
410cf90b 45
dc93df4f 46 # Single-value defaults
95ebf9b0
JRT
47 $self->{_force} = dor(delete $args{force}, $FALSE);
48 $self->{_only} = dor(delete $args{only}, $FALSE);
9f12283e 49 $self->{_profile_strictness} =
e424327a 50 dor(delete $args{'profile-strictness'}, $PROFILE_STRICTNESS_DEFAULT);
95ebf9b0
JRT
51 $self->{_single_policy} = dor(delete $args{'single-policy'}, $EMPTY);
52 $self->{_severity} = dor(delete $args{severity}, $SEVERITY_HIGHEST);
53 $self->{_theme} = dor(delete $args{theme}, $EMPTY);
54 $self->{_top} = dor(delete $args{top}, $FALSE);
55 $self->{_verbose} = dor(delete $args{verbose}, $DEFAULT_VERBOSITY);
56 $self->{_criticism_fatal} = dor(delete $args{'criticism-fatal'}, $FALSE);
57 $self->{_warn_about_useless_no_critic} =
58 dor(delete $args{'warn_about_useless_no_critic'}, $FALSE);
59 $self->{_pager} = dor(delete $args{pager}, $EMPTY);
0d63e03a 60
89b50090 61 # If we're using a pager or not outputing to a tty don't use colors.
a6677e04
ES
62 # Can't use IO::Interactive here because we /don't/ want to check STDIN.
63 my $default_color = ($self->pager() or not -t *STDOUT) ? $FALSE : $TRUE; ## no critic (ProhibitInteractiveTest)
89b50090 64 $self->{_color} = dor(delete $args{color}, dor(delete $args{colour}, $default_color));
ae9b3404 65
ee5a2bbd
ES
66 # If there's anything left, complain.
67 _check_for_extra_options(%args);
68
69 return $self;
70}
71
72#-----------------------------------------------------------------------------
73
74sub _check_for_extra_options {
75 my %args = @_;
76
0d63e03a 77 if ( my @remaining = sort keys %args ){
ee5a2bbd
ES
78 my $errors = Perl::Critic::Exception::AggregateConfiguration->new();
79
80 foreach my $option_name (@remaining) {
81 $errors->add_exception(
82 Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter->new(
83 option_name => $option_name,
84 )
85 )
86 }
87
88 $errors->rethrow();
0d63e03a 89 }
dc93df4f 90
ee5a2bbd 91 return;
dc93df4f
JRT
92}
93
94#-----------------------------------------------------------------------------
58247edc 95# Public ACCESSOR methods
410cf90b 96
dc93df4f
JRT
97sub severity {
98 my ($self) = @_;
99 return $self->{_severity};
100}
101
102#-----------------------------------------------------------------------------
103
104sub theme {
105 my ($self) = @_;
106 return $self->{_theme};
107}
108
109#-----------------------------------------------------------------------------
110
111sub exclude {
112 my ($self) = @_;
113 return $self->{_exclude};
114}
115
116#-----------------------------------------------------------------------------
117
118sub include {
119 my ($self) = @_;
120 return $self->{_include};
121}
122
123#-----------------------------------------------------------------------------
124
125sub only {
126 my ($self) = @_;
127 return $self->{_only};
128}
129
130#-----------------------------------------------------------------------------
131
9f12283e 132sub profile_strictness {
66186ba3 133 my ($self) = @_;
9f12283e 134 return $self->{_profile_strictness};
66186ba3
ES
135}
136
137#-----------------------------------------------------------------------------
138
738830ba 139sub single_policy {
585ddee1 140 my ($self) = @_;
738830ba 141 return $self->{_single_policy};
585ddee1
ES
142}
143
144#-----------------------------------------------------------------------------
145
dc93df4f
JRT
146sub verbose {
147 my ($self) = @_;
148 return $self->{_verbose};
149}
150
151#-----------------------------------------------------------------------------
152
51ae9d9b 153sub color {
25792f52 154 my ($self) = @_;
51ae9d9b 155 return $self->{_color};
25792f52
ES
156}
157
158#-----------------------------------------------------------------------------
159
89b50090
ES
160sub pager {
161 my ($self) = @_;
162 return $self->{_pager};
163}
164
165#-----------------------------------------------------------------------------
166
badbf753
JRT
167sub criticism_fatal {
168 my ($self) = @_;
169 return $self->{_criticism_fatal};
170}
171
172#-----------------------------------------------------------------------------
173
95ebf9b0
JRT
174sub warn_about_useless_no_critic {
175 my ($self) = @_;
176 return $self->{_warn_about_useless_no_critic};
177}
178
179#-----------------------------------------------------------------------------
180
dc93df4f
JRT
181sub force {
182 my ($self) = @_;
183 return $self->{_force};
184}
185
186#-----------------------------------------------------------------------------
187
188sub top {
189 my ($self) = @_;
190 return $self->{_top};
191}
192
193
1941;
195
196__END__
197
198#-----------------------------------------------------------------------------
199
200=pod
201
202=head1 NAME
203
894d344a 204Perl::Critic::OptionsProcessor - The global configuration default values, combined with command-line values.
dc93df4f 205
11f53956 206
dc93df4f
JRT
207=head1 DESCRIPTION
208
209This is a helper class that encapsulates the default parameters for
11f53956
ES
210constructing a L<Perl::Critic::Config|Perl::Critic::Config> object.
211There are no user-serviceable parts here.
212
dc93df4f
JRT
213
214=head1 CONSTRUCTOR
215
216=over 8
217
218=item C< new( %DEFAULT_PARAMS ) >
219
11f53956
ES
220Returns a reference to a new C<Perl::Critic::OptionsProcessor> object.
221You can override the coded defaults by passing in name-value pairs
222that correspond to the methods listed below.
9f12283e 223
11f53956
ES
224This is usually only invoked by
225L<Perl::Critic::UserProfile|Perl::Critic::UserProfile>, which passes
226in the global values from a F<.perlcriticrc> file. This object
9f12283e 227contains no information for individual Policies.
1ce891fa 228
dc93df4f
JRT
229=back
230
231=head1 METHODS
232
233=over 8
234
235=item C< exclude() >
236
1ce891fa 237Returns a reference to a list of the default exclusion patterns. If
11f53956
ES
238onto by
239L<Perl::Critic::PolicyParameter|Perl::Critic::PolicyParameter>. there
240are no default exclusion patterns, then the list will be empty.
241
1ce891fa 242
dc93df4f
JRT
243=item C< force() >
244
1ce891fa
JRT
245Returns the default value of the C<force> flag (Either 1 or 0).
246
11f53956 247
dc93df4f
JRT
248=item C< include() >
249
1ce891fa
JRT
250Returns a reference to a list of the default inclusion patterns. If
251there are no default exclusion patterns, then the list will be empty.
252
11f53956 253
dc93df4f
JRT
254=item C< only() >
255
1ce891fa
JRT
256Returns the default value of the C<only> flag (Either 1 or 0).
257
11f53956 258
9f12283e 259=item C< profile_strictness() >
66186ba3 260
9f12283e
ES
261Returns the default value of C<profile_strictness> as an unvalidated
262string.
66186ba3 263
11f53956 264
738830ba 265=item C< single_policy() >
585ddee1 266
badbf753 267Returns the default C<single-policy> pattern. (As a string.)
585ddee1 268
11f53956 269
dc93df4f
JRT
270=item C< severity() >
271
1ce891fa
JRT
272Returns the default C<severity> setting. (1..5).
273
11f53956 274
dc93df4f
JRT
275=item C< theme() >
276
1ce891fa
JRT
277Returns the default C<theme> setting. (As a string).
278
11f53956 279
dc93df4f
JRT
280=item C< top() >
281
1ce891fa
JRT
282Returns the default C<top> setting. (Either 0 or a positive integer).
283
11f53956 284
dc93df4f
JRT
285=item C< verbose() >
286
1ce891fa
JRT
287Returns the default C<verbose> setting. (Either a number or format
288string).
289
11f53956 290
51ae9d9b 291=item C< color() >
25792f52 292
51ae9d9b 293Returns the default C<color> setting. (Either 1 or 0).
25792f52 294
11f53956 295
89b50090
ES
296=item C< pager() >
297
298Returns the default C<pager> setting. (Either empty string or the pager
299command string).
300
301
badbf753
JRT
302=item C< criticism_fatal() >
303
304Returns the default C<criticism-fatal> setting (Either 1 or 0).
305
95ebf9b0
JRT
306=item C< warn_about_useless_no_critic() >
307
308Returns the default C<warn-about-useless-no-critic> setting (Either 1 or 0).
11f53956 309
dc93df4f
JRT
310=back
311
11f53956 312
f7392d70
ES
313=head1 SEE ALSO
314
11f53956
ES
315L<Perl::Critic::Config|Perl::Critic::Config>,
316L<Perl::Critic::UserProfile|Perl::Critic::UserProfile>
317
f7392d70 318
dc93df4f
JRT
319=head1 AUTHOR
320
321Jeffrey Ryan Thalhammer <thaljef@cpan.org>
322
11f53956 323
dc93df4f
JRT
324=head1 COPYRIGHT
325
20dfddeb 326Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer. All rights reserved.
dc93df4f
JRT
327
328This program is free software; you can redistribute it and/or modify
329it under the same terms as Perl itself. The full text of this license
330can be found in the LICENSE file included with this module.
331
332=cut
737d3b65
CD
333
334# Local Variables:
335# mode: cperl
336# cperl-indent-level: 4
337# fill-column: 78
338# indent-tabs-mode: nil
339# c-indentation-style: bsd
340# End:
96fed375 341# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :