Login
Fixed typo in the code for setting the criticism-fatal option. Damn I hate
[gknop/Perl-Critic.git] / lib / Perl / Critic / Config.pm
CommitLineData
e68db767 1##############################################################################
39cd321a
JRT
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
e68db767 6##############################################################################
39cd321a 7
59b05e08
JRT
8package Perl::Critic::Config;
9
df6dee2b 10use 5.006001;
59b05e08
JRT
11use strict;
12use warnings;
dd813c73 13
59b05e08 14use English qw(-no_match_vars);
ee5a2bbd 15use Readonly;
2e0f1c94 16
585ddee1 17use List::MoreUtils qw(any none apply);
faa35de4 18use Scalar::Util qw(blessed);
2e0f1c94 19
ee5a2bbd
ES
20use Perl::Critic::Exception::AggregateConfiguration;
21use Perl::Critic::Exception::Configuration;
22use Perl::Critic::Exception::Configuration::Option::Global::ParameterValue;
8c83273d 23use Perl::Critic::Exception::Fatal::Internal qw{ throw_internal };
410cf90b 24use Perl::Critic::PolicyFactory;
70f3f307 25use Perl::Critic::Theme qw( $RULE_INVALID_CHARACTER_REGEX cook_rule );
e68db767 26use Perl::Critic::UserProfile qw();
bbf4108c 27use Perl::Critic::Utils qw{
2e0f1c94 28 :booleans :characters :severities :internal_lookup :classification
bbf4108c 29};
9f12283e 30use Perl::Critic::Utils::Constants qw{ :profile_strictness };
459ede25 31use Perl::Critic::Utils::DataConversion qw{ boolean_to_number dor };
59b05e08 32
98768f5b
JRT
33#-----------------------------------------------------------------------------
34
a8da49fd 35our $VERSION = '1.088';
59b05e08 36
faa35de4 37#-----------------------------------------------------------------------------
ee5a2bbd
ES
38
39Readonly::Scalar my $SINGLE_POLICY_CONFIG_KEY => 'single-policy';
40
41#-----------------------------------------------------------------------------
faa35de4 42# Constructor
59b05e08
JRT
43
44sub new {
45
46 my ( $class, %args ) = @_;
47 my $self = bless {}, $class;
e68db767 48 $self->_init( %args );
faa35de4
JRT
49 return $self;
50}
dff08b70 51
faa35de4 52#-----------------------------------------------------------------------------
1e7b8681 53
faa35de4 54sub _init {
e68db767
JRT
55 my ( $self, %args ) = @_;
56
98768f5b 57 # -top or -theme imply that -severity is 1, unless it is already defined
826faac4
JRT
58 if ( defined $args{-top} || defined $args{-theme} ) {
59 $args{-severity} ||= $SEVERITY_LOWEST;
60 }
61
ee5a2bbd 62 my $errors = Perl::Critic::Exception::AggregateConfiguration->new();
2e0f1c94 63
98768f5b 64 # Construct the UserProfile to get default options.
2e0f1c94
ES
65 my $profile_source = $args{-profile}; #Can be file path or data struct
66 my $profile =
67 Perl::Critic::UserProfile->new( -profile => $profile_source );
894d344a 68 my $options_processor = $profile->options_processor();
9eb1fee5 69 $self->{_profile} = $profile;
7b84ff16 70
9f12283e
ES
71 $self->_validate_and_save_profile_strictness(
72 $args{'-profile-strictness'},
73 $errors,
74 );
75
98768f5b 76 # If given, these options should always have a true value.
2e0f1c94 77 $self->_validate_and_save_regex(
894d344a 78 'include', $args{-include}, $options_processor->include(), $errors
2e0f1c94
ES
79 );
80 $self->_validate_and_save_regex(
894d344a 81 'exclude', $args{-exclude}, $options_processor->exclude(), $errors
2e0f1c94
ES
82 );
83 $self->_validate_and_save_regex(
ee5a2bbd
ES
84 $SINGLE_POLICY_CONFIG_KEY,
85 $args{ qq/-$SINGLE_POLICY_CONFIG_KEY/ },
894d344a 86 $options_processor->single_policy(),
2e0f1c94
ES
87 $errors,
88 );
89
90 $self->_validate_and_save_verbosity($args{-verbose}, $errors);
91 $self->_validate_and_save_severity($args{-severity}, $errors);
92 $self->_validate_and_save_top($args{-top}, $errors);
7b84ff16 93
bb08289e 94 # If given, these options can be true or false (but defined)
7b84ff16 95 # We normalize these to numeric values by multiplying them by 1;
2e0f1c94 96 {
894d344a
ES
97 $self->{_force} = boolean_to_number( dor( $args{-force}, $options_processor->force() ) );
98 $self->{_only} = boolean_to_number( dor( $args{-only}, $options_processor->only() ) );
99 $self->{_color} = boolean_to_number( dor( $args{-color}, $options_processor->color() ) );
badbf753 100 $self->{_criticism_fatal} =
49f65b22 101 boolean_to_number(dor( $args{'-criticism-fatal'}, $options_processor->criticism_fatal() ) );
2e0f1c94 102 }
7b84ff16 103
2e0f1c94
ES
104 $self->_validate_and_save_theme($args{-theme}, $errors);
105
66186ba3
ES
106 # Construct a Factory with the Profile
107 my $factory =
108 Perl::Critic::PolicyFactory->new(
9f12283e
ES
109 -profile => $profile,
110 -errors => $errors,
111 '-profile-strictness' => $self->profile_strictness(),
66186ba3
ES
112 );
113 $self->{_factory} = $factory;
114
98768f5b
JRT
115 # Initialize internal storage for Policies
116 $self->{_policies} = [];
410cf90b 117
dc93df4f 118 # "NONE" means don't load any policies
ee5a2bbd
ES
119 if ( not defined $profile_source or $profile_source ne 'NONE' ) {
120 # Heavy lifting here...
121 $self->_load_policies($errors);
122 }
dc93df4f 123
ee5a2bbd
ES
124 if ( $errors->has_exceptions() ) {
125 $errors->rethrow();
126 }
585ddee1 127
dc93df4f
JRT
128 return $self;
129}
130
131#-----------------------------------------------------------------------------
7b84ff16 132
dc93df4f 133sub add_policy {
faa35de4 134
dc93df4f 135 my ( $self, %args ) = @_;
9eb1fee5 136
ee5a2bbd
ES
137 if ( not $args{-policy} ) {
138 throw_internal q{The -policy argument is required};
139 }
140
141 my $policy = $args{-policy};
e68db767 142
9eb1fee5 143 # If the -policy is already a blessed object, then just add it directly.
e68db767 144 if ( blessed $policy ) {
985e0116 145 $self->_add_policy_if_enabled($policy);
e68db767
JRT
146 return $self;
147 }
148
98768f5b 149 # NOTE: The "-config" option is supported for backward compatibility.
9eb1fee5
JRT
150 my $params = $args{-params} || $args{-config};
151
985e0116
ES
152 my $factory = $self->{_factory};
153 my $policy_object =
154 $factory->create_policy(-name=>$policy, -params=>$params);
155 $self->_add_policy_if_enabled($policy_object);
e68db767 156
faa35de4
JRT
157 return $self;
158}
c5d8050b 159
dc93df4f
JRT
160#-----------------------------------------------------------------------------
161
985e0116
ES
162sub _add_policy_if_enabled {
163 my ( $self, $policy_object ) = @_;
164
8c83273d 165 my $config = $policy_object->__get_config()
ee5a2bbd
ES
166 or throw_internal
167 q{Policy was not set up properly because it doesn't have }
8c83273d 168 . q{a value for its config attribute.};
985e0116 169
8c83273d 170 if ( $policy_object->initialize_if_enabled( $config ) ) {
985e0116
ES
171 push @{ $self->{_policies} }, $policy_object;
172 }
173
174 return;
175}
176
177#-----------------------------------------------------------------------------
178
faa35de4 179sub _load_policies {
c5d8050b 180
ee5a2bbd 181 my ( $self, $errors ) = @_;
98768f5b 182 my $factory = $self->{_factory};
ee5a2bbd
ES
183 my @policies = $factory->create_all_policies( $errors );
184
185 return if $errors->has_exceptions();
98768f5b 186
9eb1fee5 187 for my $policy ( @policies ) {
98768f5b 188
738830ba
ES
189 # If -single-policy is true, only load policies that match it
190 if ( $self->single_policy() ) {
585ddee1
ES
191 if ( $self->_policy_is_single_policy( $policy ) ) {
192 $self->add_policy( -policy => $policy );
193 }
98768f5b 194 next;
585ddee1
ES
195 }
196
98768f5b 197 # To load, or not to load -- that is the question.
e68db767 198 my $load_me = $self->only() ? $FALSE : $TRUE;
c5d8050b 199
98768f5b
JRT
200 ## no critic (ProhibitPostfixControls)
201 $load_me = $FALSE if $self->_policy_is_disabled( $policy );
202 $load_me = $TRUE if $self->_policy_is_enabled( $policy );
203 $load_me = $FALSE if $self->_policy_is_unimportant( $policy );
58247edc 204 $load_me = $FALSE if not $self->_policy_is_thematic( $policy );
98768f5b
JRT
205 $load_me = $TRUE if $self->_policy_is_included( $policy );
206 $load_me = $FALSE if $self->_policy_is_excluded( $policy );
207
c5d8050b 208
faa35de4 209 next if not $load_me;
e68db767 210 $self->add_policy( -policy => $policy );
faa35de4 211 }
c5d8050b 212
738830ba
ES
213 # When using -single-policy, only one policy should ever be loaded.
214 if ($self->single_policy() && scalar $self->policies() != 1) {
ee5a2bbd 215 $self->_add_single_policy_exception_to($errors);
98768f5b
JRT
216 }
217
2e0f1c94 218 return;
faa35de4
JRT
219}
220
221#-----------------------------------------------------------------------------
faa35de4 222
dc93df4f
JRT
223sub _policy_is_disabled {
224 my ($self, $policy) = @_;
2e0f1c94 225 my $profile = $self->_profile();
dc93df4f 226 return $profile->policy_is_disabled( $policy );
faa35de4
JRT
227}
228
229#-----------------------------------------------------------------------------
230
e68db767 231sub _policy_is_enabled {
faa35de4 232 my ($self, $policy) = @_;
2e0f1c94 233 my $profile = $self->_profile();
dc93df4f 234 return $profile->policy_is_enabled( $policy );
faa35de4
JRT
235}
236
237#-----------------------------------------------------------------------------
238
dc93df4f 239sub _policy_is_thematic {
faa35de4 240 my ($self, $policy) = @_;
98768f5b
JRT
241 my $theme = $self->theme();
242 return $theme->policy_is_thematic( -policy => $policy );
faa35de4
JRT
243}
244
245#-----------------------------------------------------------------------------
246
247sub _policy_is_unimportant {
248 my ($self, $policy) = @_;
249 my $policy_severity = $policy->get_severity();
dc93df4f 250 my $min_severity = $self->{_severity};
faa35de4
JRT
251 return $policy_severity < $min_severity;
252}
253
254#-----------------------------------------------------------------------------
255
256sub _policy_is_included {
257 my ($self, $policy) = @_;
dc93df4f 258 my $policy_long_name = ref $policy;
faa35de4
JRT
259 my @inclusions = $self->include();
260 return any { $policy_long_name =~ m/$_/imx } @inclusions;
261}
262
263#-----------------------------------------------------------------------------
264
265sub _policy_is_excluded {
266 my ($self, $policy) = @_;
dc93df4f 267 my $policy_long_name = ref $policy;
faa35de4
JRT
268 my @exclusions = $self->exclude();
269 return any { $policy_long_name =~ m/$_/imx } @exclusions;
270}
271
6036a254 272#-----------------------------------------------------------------------------
585ddee1
ES
273
274sub _policy_is_single_policy {
275 my ($self, $policy) = @_;
2e0f1c94 276
738830ba 277 my @patterns = $self->single_policy();
2e0f1c94
ES
278 return if not @patterns;
279
585ddee1 280 my $policy_long_name = ref $policy;
2e0f1c94 281 return any { $policy_long_name =~ m/$_/imx } @patterns;
98768f5b
JRT
282}
283
284#-----------------------------------------------------------------------------
285
ee5a2bbd
ES
286sub _new_global_value_exception {
287 my ($self, @args) = @_;
9eb1fee5 288
ee5a2bbd
ES
289 return
290 Perl::Critic::Exception::Configuration::Option::Global::ParameterValue
291 ->new(@args);
292}
293
294#-----------------------------------------------------------------------------
295
296sub _add_single_policy_exception_to {
297 my ($self, $errors) = @_;
98768f5b 298
ee5a2bbd 299 my $message_suffix = $EMPTY;
738830ba 300 my $patterns = join q{", "}, $self->single_policy();
98768f5b
JRT
301
302 if (scalar $self->policies() == 0) {
ee5a2bbd
ES
303 $message_suffix =
304 q{did not match any policies (in combination with }
2e0f1c94 305 . q{other policy restrictions).};
98768f5b
JRT
306 }
307 else {
ee5a2bbd
ES
308 $message_suffix = qq{matched multiple policies:\n\t};
309 $message_suffix .= join qq{,\n\t}, apply { chomp } sort $self->policies();
98768f5b
JRT
310 }
311
ee5a2bbd
ES
312 $errors->add_exception(
313 $self->_new_global_value_exception(
314 option_name => $SINGLE_POLICY_CONFIG_KEY,
315 option_value => $patterns,
316 message_suffix => $message_suffix,
317 )
318 );
319
320 return;
2e0f1c94
ES
321}
322
323#-----------------------------------------------------------------------------
324
325sub _validate_and_save_regex {
326 my ($self, $option_name, $args_value, $default_value, $errors) = @_;
327
328 my $full_option_name;
329 my $source;
330 my @regexes;
331
332 if ($args_value) {
333 $full_option_name = "-$option_name";
334
335 if (ref $args_value) {
336 @regexes = @{ $args_value };
337 }
338 else {
339 @regexes = ( $args_value );
340 }
341 }
342
343 if (not @regexes) {
344 $full_option_name = $option_name;
345 $source = $self->_profile()->source();
346
347 if (ref $default_value) {
348 @regexes = @{ $default_value };
349 }
350 elsif ($default_value) {
351 @regexes = ( $default_value );
352 }
353 }
354
355 my $found_errors;
356 foreach my $regex (@regexes) {
dd813c73
ES
357 eval { my $test = qr/$regex/imx; }
358 or do {
359 my $cleaned_error = $EVAL_ERROR || '<unknown reason>';
360 $cleaned_error =~
361 s/ [ ] at [ ] .* Config [.] pm [ ] line [ ] \d+ [.] \n? \z/./xms;
362
363 $errors->add_exception(
364 $self->_new_global_value_exception(
365 option_name => $option_name,
366 option_value => $regex,
367 source => $source,
368 message_suffix => qq{is not valid: $cleaned_error},
369 )
370 );
371
372 $found_errors = 1;
373 }
2e0f1c94
ES
374 }
375
376 if (not $found_errors) {
738830ba
ES
377 my $option_key = $option_name;
378 $option_key =~ s/ - /_/xmsg;
379
380 $self->{"_$option_key"} = \@regexes;
2e0f1c94
ES
381 }
382
383 return;
384}
385
386#-----------------------------------------------------------------------------
387
9f12283e
ES
388sub _validate_and_save_profile_strictness {
389 my ($self, $args_value, $errors) = @_;
390
391 my $option_name;
392 my $source;
393 my $profile_strictness;
394
395 if ($args_value) {
396 $option_name = '-profile-strictness';
397 $profile_strictness = $args_value;
398 }
399 else {
400 $option_name = 'profile-strictness';
401
402 my $profile = $self->_profile();
403 $source = $profile->source();
894d344a 404 $profile_strictness = $profile->options_processor()->profile_strictness();
9f12283e
ES
405 }
406
407 if ( not $PROFILE_STRICTNESSES{$profile_strictness} ) {
ee5a2bbd
ES
408 $errors->add_exception(
409 $self->_new_global_value_exception(
410 option_name => $option_name,
411 option_value => $profile_strictness,
412 source => $source,
413 message_suffix => q{is not one of "}
414 . join ( q{", "}, (sort keys %PROFILE_STRICTNESSES) )
415 . q{".},
416 )
9f12283e
ES
417 );
418
419 $profile_strictness = $PROFILE_STRICTNESS_FATAL;
420 }
421
422 $self->{_profile_strictness} = $profile_strictness;
423
424 return;
425}
426
427#-----------------------------------------------------------------------------
428
2e0f1c94
ES
429sub _validate_and_save_verbosity {
430 my ($self, $args_value, $errors) = @_;
431
432 my $option_name;
433 my $source;
434 my $verbosity;
435
436 if ($args_value) {
437 $option_name = '-verbose';
438 $verbosity = $args_value;
439 }
440 else {
441 $option_name = 'verbose';
442
443 my $profile = $self->_profile();
444 $source = $profile->source();
894d344a 445 $verbosity = $profile->options_processor()->verbose();
2e0f1c94
ES
446 }
447
ee5a2bbd
ES
448 if (
449 is_integer($verbosity)
450 and not is_valid_numeric_verbosity($verbosity)
451 ) {
452 $errors->add_exception(
453 $self->_new_global_value_exception(
454 option_name => $option_name,
455 option_value => $verbosity,
456 source => $source,
457 message_suffix =>
458 'is not the number of one of the pre-defined verbosity formats.',
459 )
2e0f1c94
ES
460 );
461 }
462 else {
463 $self->{_verbose} = $verbosity;
464 }
465
466 return;
467}
468
469#-----------------------------------------------------------------------------
470
471sub _validate_and_save_severity {
472 my ($self, $args_value, $errors) = @_;
473
474 my $option_name;
475 my $source;
476 my $severity;
477
478 if ($args_value) {
479 $option_name = '-severity';
480 $severity = $args_value;
481 }
482 else {
483 $option_name = 'severity';
484
485 my $profile = $self->_profile();
486 $source = $profile->source();
894d344a 487 $severity = $profile->options_processor()->severity();
2e0f1c94
ES
488 }
489
490 if ( is_integer($severity) ) {
491 if (
492 $severity >= $SEVERITY_LOWEST and $severity <= $SEVERITY_HIGHEST
493 ) {
494 $self->{_severity} = $severity;
495 }
496 else {
ee5a2bbd
ES
497 $errors->add_exception(
498 $self->_new_global_value_exception(
499 option_name => $option_name,
500 option_value => $severity,
501 source => $source,
502 message_suffix =>
503 "is not between $SEVERITY_LOWEST (low) and $SEVERITY_HIGHEST (high).",
504 )
2e0f1c94
ES
505 );
506 }
507 }
508 elsif ( not any { $_ eq lc $severity } @SEVERITY_NAMES ) {
ee5a2bbd
ES
509 $errors->add_exception(
510 $self->_new_global_value_exception(
511 option_name => $option_name,
512 option_value => $severity,
513 source => $source,
514 message_suffix =>
515 q{is not one of the valid severity names: "}
516 . join (q{", "}, @SEVERITY_NAMES)
517 . q{".},
518 )
2e0f1c94
ES
519 );
520 }
521 else {
522 $self->{_severity} = severity_to_number($severity);
523 }
524
525 return;
526}
527
528#-----------------------------------------------------------------------------
529
530sub _validate_and_save_top {
531 my ($self, $args_value, $errors) = @_;
532
533 my $option_name;
534 my $source;
535 my $top;
536
537 if (defined $args_value and $args_value ne q{}) {
538 $option_name = '-top';
539 $top = $args_value;
540 }
541 else {
542 $option_name = 'top';
543
544 my $profile = $self->_profile();
545 $source = $profile->source();
894d344a 546 $top = $profile->options_processor()->top();
2e0f1c94
ES
547 }
548
549 if ( is_integer($top) and $top >= 0 ) {
550 $self->{_top} = $top;
551 }
552 else {
ee5a2bbd
ES
553 $errors->add_exception(
554 $self->_new_global_value_exception(
555 option_name => $option_name,
556 option_value => $top,
557 source => $source,
558 message_suffix => q{is not a non-negative integer.},
559 )
2e0f1c94
ES
560 );
561 }
562
563 return;
564}
565
566#-----------------------------------------------------------------------------
567
568sub _validate_and_save_theme {
569 my ($self, $args_value, $errors) = @_;
570
571 my $option_name;
572 my $source;
573 my $theme_rule;
574
575 if ($args_value) {
576 $option_name = '-theme';
577 $theme_rule = $args_value;
578 }
579 else {
580 $option_name = 'theme';
581
582 my $profile = $self->_profile();
583 $source = $profile->source();
894d344a 584 $theme_rule = $profile->options_processor()->theme();
2e0f1c94
ES
585 }
586
587 if ( $theme_rule =~ m/$RULE_INVALID_CHARACTER_REGEX/xms ) {
588 my $bad_character = $1;
589
ee5a2bbd
ES
590 $errors->add_exception(
591 $self->_new_global_value_exception(
592 option_name => $option_name,
593 option_value => $theme_rule,
594 source => $source,
595 message_suffix =>
596 qq{contains an illegal character ("$bad_character").},
597 )
2e0f1c94
ES
598 );
599 }
600 else {
601 my $rule_as_code = cook_rule($theme_rule);
2e0f1c94 602 $rule_as_code =~ s/ [\w\d]+ / 1 /gxms;
839af03d 603
dd813c73 604 # eval of an empty string does not reset $@ in Perl 5.6.
c436bd4d 605 local $EVAL_ERROR = $EMPTY;
dd813c73 606 eval $rule_as_code; ## no critic (ProhibitStringyEval, RequireCheckingReturnValueOfEval)
2e0f1c94
ES
607
608 if ($EVAL_ERROR) {
ee5a2bbd
ES
609 $errors->add_exception(
610 $self->_new_global_value_exception(
611 option_name => $option_name,
612 option_value => $theme_rule,
613 source => $source,
614 message_suffix => q{is not syntactically valid.},
615 )
2e0f1c94
ES
616 );
617 }
618 else {
ee5a2bbd
ES
619 eval {
620 $self->{_theme} =
621 Perl::Critic::Theme->new( -rule => $theme_rule );
dd813c73
ES
622 }
623 or do {
624 $errors->add_exception_or_rethrow( $EVAL_ERROR );
625 };
2e0f1c94
ES
626 }
627 }
628
629 return;
585ddee1
ES
630}
631
6036a254 632#-----------------------------------------------------------------------------
faa35de4
JRT
633# Begin ACCESSSOR methods
634
2e0f1c94
ES
635sub _profile {
636 my $self = shift;
637 return $self->{_profile};
638}
639
640#-----------------------------------------------------------------------------
641
dff08b70
JRT
642sub policies {
643 my $self = shift;
faa35de4
JRT
644 return @{ $self->{_policies} };
645}
646
6036a254 647#-----------------------------------------------------------------------------
faa35de4 648
dc93df4f 649sub exclude {
faa35de4 650 my $self = shift;
dc93df4f 651 return @{ $self->{_exclude} };
faa35de4
JRT
652}
653
6036a254 654#-----------------------------------------------------------------------------
faa35de4 655
dc93df4f 656sub force {
faa35de4 657 my $self = shift;
dc93df4f 658 return $self->{_force};
faa35de4
JRT
659}
660
6036a254 661#-----------------------------------------------------------------------------
dc93df4f 662
faa35de4
JRT
663sub include {
664 my $self = shift;
665 return @{ $self->{_include} };
666}
667
6036a254 668#-----------------------------------------------------------------------------
faa35de4 669
dc93df4f
JRT
670sub only {
671 my $self = shift;
672 return $self->{_only};
4e98e72e 673}
585ddee1 674
6036a254 675#-----------------------------------------------------------------------------
e68db767 676
9f12283e 677sub profile_strictness {
66186ba3 678 my $self = shift;
9f12283e 679 return $self->{_profile_strictness};
66186ba3
ES
680}
681
682#-----------------------------------------------------------------------------
683
e68db767
JRT
684sub severity {
685 my $self = shift;
686 return $self->{_severity};
687}
6d9feae6 688
6036a254 689#-----------------------------------------------------------------------------
6288d2b4 690
738830ba 691sub single_policy {
585ddee1 692 my $self = shift;
738830ba 693 return @{ $self->{_single_policy} };
585ddee1
ES
694}
695
6036a254 696#-----------------------------------------------------------------------------
585ddee1 697
dc93df4f
JRT
698sub theme {
699 my $self = shift;
700 return $self->{_theme};
6288d2b4
JRT
701}
702
6036a254 703#-----------------------------------------------------------------------------
59b05e08 704
dc93df4f
JRT
705sub top {
706 my $self = shift;
707 return $self->{_top};
63b96364
JRT
708}
709
6036a254 710#-----------------------------------------------------------------------------
59b05e08 711
dc93df4f
JRT
712sub verbose {
713 my $self = shift;
714 return $self->{_verbose};
59b05e08
JRT
715}
716
6036a254 717#-----------------------------------------------------------------------------
59b05e08 718
51ae9d9b 719sub color {
25792f52 720 my $self = shift;
51ae9d9b 721 return $self->{_color};
25792f52
ES
722}
723
724#-----------------------------------------------------------------------------
725
badbf753
JRT
726sub criticism_fatal {
727 my $self = shift;
728 return $self->{_criticism_fatal};
729}
730
731#-----------------------------------------------------------------------------
732
410cf90b
JRT
733sub site_policy_names {
734 return Perl::Critic::PolicyFactory::site_policy_names();
59b05e08
JRT
735}
736
dff08b70 7371;
59b05e08 738
6036a254 739#-----------------------------------------------------------------------------
59b05e08 740
59b05e08
JRT
741__END__
742
743=pod
744
51ae9d9b 745=for stopwords -params INI-style
410cf90b 746
59b05e08
JRT
747=head1 NAME
748
f7392d70 749Perl::Critic::Config - The final derived Perl::Critic configuration, combined from any profile file and command-line parameters.
59b05e08
JRT
750
751=head1 DESCRIPTION
752
753Perl::Critic::Config takes care of finding and processing
11f53956
ES
754user-preferences for L<Perl::Critic|Perl::Critic>. The Config object
755defines which Policy modules will be loaded into the Perl::Critic
756engine and how they should be configured. You should never really
757need to instantiate Perl::Critic::Config directly because the
758Perl::Critic constructor will do it for you.
59b05e08
JRT
759
760=head1 CONSTRUCTOR
761
762=over 8
763
badbf753 764=item C<< new( [ -profile => $FILE, -severity => $N, -theme => $string, -include => \@PATTERNS, -exclude => \@PATTERNS, -single-policy => $PATTERN, -top => $N, -only => $B, -profile-strictness => $PROFILE_STRICTNESS_{WARN|FATAL|QUIET}, -force => $B, -verbose => $N, -color => $B, -criticism-fatal => $B] ) >>
7b84ff16
JRT
765
766=item C<< new() >>
59b05e08 767
7b84ff16
JRT
768Returns a reference to a new Perl::Critic::Config object. The default
769value for all arguments can be defined in your F<.perlcriticrc> file.
770See the L<"CONFIGURATION"> section for more information about that.
771All arguments are optional key-value pairs as follows:
59b05e08
JRT
772
773B<-profile> is a path to a configuration file. If C<$FILE> is not
774defined, Perl::Critic::Config attempts to find a F<.perlcriticrc>
775configuration file in the current directory, and then in your home
776directory. Alternatively, you can set the C<PERLCRITIC> environment
777variable to point to a file in another location. If a configuration
6bf9b465
JRT
778file can't be found, or if C<$FILE> is an empty string, then all
779Policies will be loaded with their default configuration. See
780L<"CONFIGURATION"> for more information.
1e7b8681
JRT
781
782B<-severity> is the minimum severity level. Only Policy modules that
783have a severity greater than C<$N> will be loaded into this Config.
784Severity values are integers ranging from 1 (least severe) to 5 (most
785severe). The default is 5. For a given C<-profile>, decreasing the
786C<-severity> will usually result in more Policy violations. Users can
787redefine the severity level for any Policy in their F<.perlcriticrc>
788file. See L<"CONFIGURATION"> for more information.
789
7b84ff16
JRT
790B<-theme> is special string that defines a set of Policies based on
791their respective themes. If C<-theme> is given, only policies that
792are members of that set will be loaded. See the L<"POLICY THEMES">
793section for more information about themes. Unless the C<-severity>
794option is explicitly given, setting C<-theme> causes the C<-severity>
795to be set to 1.
796
6bf9b465
JRT
797B<-include> is a reference to a list of string C<@PATTERNS>. Policies
798that match at least one C<m/$PATTERN/imx> will be loaded into this
799Config, irrespective of the severity settings. You can use it in
800conjunction with the C<-exclude> option. Note that C<-exclude> takes
801precedence over C<-include> when a Policy matches both patterns.
1e7b8681 802
6bf9b465
JRT
803B<-exclude> is a reference to a list of string C<@PATTERNS>. Polices
804that match at least one C<m/$PATTERN/imx> will not be loaded into this
805Config, irrespective of the severity settings. You can use it in
806conjunction with the C<-include> option. Note that C<-exclude> takes
807precedence over C<-include> when a Policy matches both patterns.
59b05e08 808
11f53956
ES
809B<-single-policy> is a string C<PATTERN>. Only the policy that
810matches C<m/$PATTERN/imx> will be used. This value overrides the
585ddee1
ES
811C<-severity>, C<-theme>, C<-include>, C<-exclude>, and C<-only>
812options.
813
7b84ff16
JRT
814B<-top> is the maximum number of Violations to return when ranked by
815their severity levels. This must be a positive integer. Violations
816are still returned in the order that they occur within the file.
817Unless the C<-severity> option is explicitly given, setting C<-top>
818silently causes the C<-severity> to be set to 1.
819
820B<-only> is a boolean value. If set to a true value, Perl::Critic
821will only choose from Policies that are mentioned in the user's
822profile. If set to a false value (which is the default), then
823Perl::Critic chooses from all the Policies that it finds at your site.
824
9f12283e
ES
825B<-profile-strictness> is an enumerated value, one of
826L<Perl::Critic::Utils::Constants/"$PROFILE_STRICTNESS_WARN"> (the
827default),
828L<Perl::Critic::Utils::Constants/"$PROFILE_STRICTNESS_FATAL">, and
829L<Perl::Critic::Utils::Constants/"$PROFILE_STRICTNESS_QUIET">. If set
830to L<Perl::Critic::Utils::Constants/"$PROFILE_STRICTNESS_FATAL">,
66186ba3
ES
831Perl::Critic will make certain warnings about problems found in a
832F<.perlcriticrc> or file specified via the B<-profile> option fatal.
9f12283e
ES
833For example, Perl::Critic normally only C<warn>s about profiles
834referring to non-existent Policies, but this value makes this
835situation fatal. Correspondingly,
836L<Perl::Critic::Utils::Constants/"$PROFILE_STRICTNESS_QUIET"> makes
837Perl::Critic shut up about these things.
66186ba3 838
7b84ff16
JRT
839B<-force> controls whether Perl::Critic observes the magical C<"## no
840critic"> pseudo-pragmas in your code. If set to a true value,
841Perl::Critic will analyze all code. If set to a false value (which is
842the default) Perl::Critic will ignore code that is tagged with these
936d9576
ES
843comments. See L<Perl::Critic/"BENDING THE RULES"> for more
844information.
7b84ff16
JRT
845
846B<-verbose> can be a positive integer (from 1 to 10), or a literal
11f53956
ES
847format specification. See
848L<Perl::Critic::Violations|Perl::Critic::Violations> for an
7b84ff16
JRT
849explanation of format specifications.
850
51ae9d9b 851B<-color> is not used by Perl::Critic but is provided for the benefit
11f53956 852of L<perlcritic|perlcritic>.
25792f52 853
11f53956
ES
854B<-criticism-fatal> is not used by Perl::Critic but is provided for
855the benefit of L<criticism|criticism>.
badbf753
JRT
856
857
858
59b05e08
JRT
859=back
860
dff08b70
JRT
861=head1 METHODS
862
863=over 8
864
520f00c6 865=item C<< add_policy( -policy => $policy_name, -params => \%param_hash ) >>
dff08b70 866
520f00c6
JRT
867Creates a Policy object and loads it into this Config. If the object
868cannot be instantiated, it will throw a fatal exception. Otherwise,
869it returns a reference to this Critic.
1e7b8681 870
11f53956
ES
871B<-policy> is the name of a
872L<Perl::Critic::Policy|Perl::Critic::Policy> subclass module. The
873C<'Perl::Critic::Policy'> portion of the name can be omitted for
874brevity. This argument is required.
1e7b8681 875
520f00c6
JRT
876B<-params> is an optional reference to a hash of Policy parameters.
877The contents of this hash reference will be passed into to the
878constructor of the Policy module. See the documentation in the
879relevant Policy module for a description of the arguments it supports.
faa35de4 880
dc93df4f 881=item C< policies() >
dff08b70 882
1e7b8681
JRT
883Returns a list containing references to all the Policy objects that
884have been loaded into this Config. Objects will be in the order that
885they were loaded.
dff08b70 886
dc93df4f 887=item C< exclude() >
50e1d0c8 888
7b84ff16 889Returns the value of the C<-exclude> attribute for this Config.
50e1d0c8 890
dc93df4f 891=item C< include() >
50e1d0c8 892
7b84ff16
JRT
893Returns the value of the C<-include> attribute for this Config.
894
895=item C< force() >
896
897Returns the value of the C<-force> attribute for this Config.
898
dc93df4f 899=item C< only() >
50e1d0c8 900
7b84ff16
JRT
901Returns the value of the C<-only> attribute for this Config.
902
9f12283e 903=item C< profile_strictness() >
66186ba3 904
9f12283e
ES
905Returns the value of the C<-profile-strictness> attribute for this
906Config.
66186ba3 907
dc93df4f 908=item C< severity() >
50e1d0c8 909
7b84ff16
JRT
910Returns the value of the C<-severity> attribute for this Config.
911
738830ba 912=item C< single_policy() >
585ddee1 913
738830ba 914Returns the value of the C<-single-policy> attribute for this Config.
585ddee1 915
dc93df4f
JRT
916=item C< theme() >
917
11f53956
ES
918Returns the L<Perl::Critic::Theme|Perl::Critic::Theme> object that was
919created for this Config.
7b84ff16 920
dc93df4f
JRT
921=item C< top() >
922
7b84ff16
JRT
923Returns the value of the C<-top> attribute for this Config.
924
dc93df4f 925=item C< verbose() >
50e1d0c8 926
7b84ff16
JRT
927Returns the value of the C<-verbose> attribute for this Config.
928
51ae9d9b 929=item C< color() >
25792f52 930
51ae9d9b 931Returns the value of the C<-color> attribute for this Config.
25792f52 932
badbf753
JRT
933=item C< criticism_fatal() >
934
935Returns the value of the C<-criticsm-fatal> attribute for this Config.
936
dff08b70
JRT
937=back
938
59b05e08
JRT
939=head1 SUBROUTINES
940
941Perl::Critic::Config has a few static subroutines that are used
942internally, but may be useful to you in some way.
943
944=over 8
945
410cf90b 946=item C<site_policy_names()>
59b05e08 947
dff08b70
JRT
948Returns a list of all the Policy modules that are currently installed
949in the Perl::Critic:Policy namespace. These will include modules that
950are distributed with Perl::Critic plus any third-party modules that
951have been installed.
59b05e08 952
59b05e08
JRT
953=back
954
955=head1 CONFIGURATION
956
7b84ff16 957Most of the settings for Perl::Critic and each of the Policy modules
2a559fb5 958can be controlled by a configuration file. The default configuration
11f53956
ES
959file is called F<.perlcriticrc>.
960L<Perl::Critic::Config|Perl::Critic::Config> will look for this file
961in the current directory first, and then in your home directory.
962Alternatively, you can set the C<PERLCRITIC> environment variable to
963explicitly point to a different file in another location. If none of
964these files exist, and the C<-profile> option is not given to the
965constructor, then all Policies will be loaded with their default
966configuration.
967
968The format of the configuration file is a series of INI-style blocks
969that contain key-value pairs separated by '='. Comments should start
970with '#' and can be placed on a separate line or after the name-value
971pairs if you desire.
7b84ff16
JRT
972
973Default settings for Perl::Critic itself can be set B<before the first
974named block.> For example, putting any or all of these at the top of
975your configuration file will set the default value for the
976corresponding Perl::Critic constructor argument.
977
c3b1b521
JRT
978 severity = 3 #Integer from 1 to 5
979 only = 1 #Zero or One
980 force = 0 #Zero or One
981 verbose = 4 #Integer or format spec
982 top = 50 #A positive integer
983 theme = risky + (pbp * security) - cosmetic #A theme expression
984 include = NamingConventions ClassHierarchies #Space-delimited list
985 exclude = Variables Modules::RequirePackage #Space-delimited list
51ae9d9b 986 color = 1 #Zero or One
7b84ff16
JRT
987
988The remainder of the configuration file is a series of blocks like
989this:
59b05e08
JRT
990
991 [Perl::Critic::Policy::Category::PolicyName]
1e7b8681 992 severity = 1
4cd0567c 993 set_themes = foo bar
c94fb804 994 add_themes = baz
59b05e08
JRT
995 arg1 = value1
996 arg2 = value2
997
998C<Perl::Critic::Policy::Category::PolicyName> is the full name of a
999module that implements the policy. The Policy modules distributed
1000with Perl::Critic have been grouped into categories according to the
1001table of contents in Damian Conway's book B<Perl Best Practices>. For
11f53956
ES
1002brevity, you can omit the C<'Perl::Critic::Policy'> part of the module
1003name.
59b05e08 1004
1e7b8681
JRT
1005C<severity> is the level of importance you wish to assign to the
1006Policy. All Policy modules are defined with a default severity value
1007ranging from 1 (least severe) to 5 (most severe). However, you may
1008disagree with the default severity and choose to give it a higher or
1009lower severity, based on your own coding philosophy.
59b05e08 1010
6bf9b465
JRT
1011The remaining key-value pairs are configuration parameters that will
1012be passed into the constructor of that Policy. The constructors for
1013most Policy modules do not support arguments, and those that do should
1014have reasonable defaults. See the documentation on the appropriate
1015Policy module for more details.
59b05e08 1016
6bf9b465
JRT
1017Instead of redefining the severity for a given Policy, you can
1018completely disable a Policy by prepending a '-' to the name of the
1019module in your configuration file. In this manner, the Policy will
1020never be loaded, regardless of the C<-severity> given to the
1021Perl::Critic::Config constructor.
59b05e08
JRT
1022
1023A simple configuration might look like this:
1024
1025 #--------------------------------------------------------------
1e7b8681 1026 # I think these are really important, so always load them
59b05e08 1027
240d3a29 1028 [TestingAndDebugging::RequireUseStrict]
1e7b8681 1029 severity = 5
59b05e08 1030
240d3a29 1031 [TestingAndDebugging::RequireUseWarnings]
1e7b8681 1032 severity = 5
59b05e08
JRT
1033
1034 #--------------------------------------------------------------
1e7b8681 1035 # I think these are less important, so only load when asked
59b05e08
JRT
1036
1037 [Variables::ProhibitPackageVars]
1e7b8681 1038 severity = 2
59b05e08
JRT
1039
1040 [ControlStructures::ProhibitPostfixControls]
7b84ff16 1041 allow = if unless #My custom configuration
1e7b8681 1042 severity = 2
59b05e08
JRT
1043
1044 #--------------------------------------------------------------
7b84ff16
JRT
1045 # Give these policies a custom theme. I can activate just
1046 # these policies by saying (-theme => 'larry + curly')
1047
1048 [Modules::RequireFilenameMatchesPackage]
c94fb804 1049 add_themes = larry
7b84ff16
JRT
1050
1051 [TestingAndDebugging::RequireTestLables]
c94fb804 1052 add_themes = curly moe
7b84ff16
JRT
1053
1054 #--------------------------------------------------------------
1e7b8681 1055 # I do not agree with these at all, so never load them
59b05e08
JRT
1056
1057 [-NamingConventions::ProhibitMixedCaseVars]
1058 [-NamingConventions::ProhibitMixedCaseSubs]
1059
1e7b8681 1060 #--------------------------------------------------------------
203f34f1
JRT
1061 # For all other Policies, I accept the default severity, theme
1062 # and other parameters, so no additional configuration is
1063 # required for them.
1e7b8681 1064
b87fc7eb
JRT
1065For additional configuration examples, see the F<perlcriticrc> file
1066that is included in this F<t/examples> directory of this distribution.
1067
7b84ff16
JRT
1068=head1 THE POLICIES
1069
1070A large number of Policy modules are distributed with Perl::Critic.
1071They are described briefly in the companion document
11f53956
ES
1072L<Perl::Critic::PolicySummary|Perl::Critic::PolicySummary> and in more
1073detail in the individual modules themselves.
7b84ff16
JRT
1074
1075=head1 POLICY THEMES
1076
11f53956
ES
1077Each Policy is defined with one or more "themes". Themes can be used
1078to create arbitrary groups of Policies. They are intended to provide
1079an alternative mechanism for selecting your preferred set of Policies.
1080For example, you may wish disable a certain subset of Policies when
1081analyzing test scripts. Conversely, you may wish to enable only a
1082specific subset of Policies when analyzing modules.
203f34f1
JRT
1083
1084The Policies that ship with Perl::Critic are have been broken into the
11f53956
ES
1085following themes. This is just our attempt to provide some basic
1086logical groupings. You are free to invent new themes that suit your
1087needs.
203f34f1
JRT
1088
1089 THEME DESCRIPTION
1090 --------------------------------------------------------------------------
1091 core All policies that ship with Perl::Critic
1092 pbp Policies that come directly from "Perl Best Practices"
1093 bugs Policies that that prevent or reveal bugs
1094 maintenance Policies that affect the long-term health of the code
1095 cosmetic Policies that only have a superficial effect
1096 complexity Policies that specificaly relate to code complexity
1097 security Policies that relate to security issues
1098 tests Policies that are specific to test scripts
7b84ff16
JRT
1099
1100
1101Say C<`perlcritic -list`> to get a listing of all available policies
1102and the themes that are associated with each one. You can also change
1103the theme for any Policy in your F<.perlcriticrc> file. See the
1104L<"CONFIGURATION"> section for more information about that.
1105
11f53956
ES
1106Using the C<-theme> option, you can combine theme names with
1107mathematical and boolean operators to create an arbitrarily complex
1108expression that represents a custom "set" of Policies. The following
1109operators are supported
7b84ff16 1110
203f34f1 1111 Operator Alternative Meaning
c3b1b521 1112 ----------------------------------------------------------------------------
7b84ff16
JRT
1113 * and Intersection
1114 - not Difference
1115 + or Union
1116
1117Operator precedence is the same as that of normal mathematics. You
11f53956
ES
1118can also use parenthesis to enforce precedence. Here are some
1119examples:
7b84ff16
JRT
1120
1121 Expression Meaning
c3b1b521 1122 ----------------------------------------------------------------------------
203f34f1
JRT
1123 pbp * bugs All policies that are "pbp" AND "bugs"
1124 pbp and bugs Ditto
7b84ff16 1125
203f34f1
JRT
1126 bugs + cosmetic All policies that are "bugs" OR "cosmetic"
1127 bugs or cosmetic Ditto
7b84ff16 1128
203f34f1 1129 pbp - cosmetic All policies that are "pbp" BUT NOT "cosmetic"
7b84ff16
JRT
1130 pbp not cosmetic Ditto
1131
203f34f1
JRT
1132 -maintenance All policies that are NOT "maintenance"
1133 not maintenance Ditto
7b84ff16 1134
203f34f1
JRT
1135 (pbp - bugs) * complexity All policies that are "pbp" BUT NOT "bugs",
1136 AND "complexity"
1137 (pbp not bugs) and complexity Ditto
7b84ff16 1138
11f53956
ES
1139Theme names are case-insensitive. If C<-theme> is set to an empty
1140string, then it is equivalent to the set of all Policies. A theme
1141name that doesn't exist is equivalent to an empty set. Please See
7b84ff16
JRT
1142L<http://en.wikipedia.org/wiki/Set> for a discussion on set theory.
1143
f7392d70
ES
1144=head1 SEE ALSO
1145
11f53956
ES
1146L<Perl::Critic::OptionsProcessor|Perl::Critic::OptionsProcessor>,
1147L<Perl::Critic::UserProfile|Perl::Critic::UserProfile>
f7392d70
ES
1148
1149
59b05e08
JRT
1150=head1 AUTHOR
1151
1152Jeffrey Ryan Thalhammer <thaljef@cpan.org>
1153
1154=head1 COPYRIGHT
1155
20dfddeb 1156Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer. All rights reserved.
59b05e08
JRT
1157
1158This program is free software; you can redistribute it and/or modify
1159it under the same terms as Perl itself. The full text of this license
1160can be found in the LICENSE file included with this module.
1161
1162=cut
737d3b65 1163
34510f7e 1164##############################################################################
737d3b65
CD
1165# Local Variables:
1166# mode: cperl
1167# cperl-indent-level: 4
1168# fill-column: 78
1169# indent-tabs-mode: nil
1170# c-indentation-style: bsd
1171# End:
96fed375 1172# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :