Login
Add new policy Variables::ProhibitMatchVars
[gknop/Perl-Critic.git] / lib / Perl / Critic / Config.pm
CommitLineData
39cd321a
JRT
1#######################################################################
2# $URL$
3# $Date$
4# $Author$
5# $Revision$
6########################################################################
7
59b05e08
JRT
8package Perl::Critic::Config;
9
10use strict;
11use warnings;
12use File::Spec;
13use Config::Tiny;
14use English qw(-no_match_vars);
15use List::MoreUtils qw(any none);
16use Perl::Critic::Utils;
dff08b70 17use Carp qw(carp croak);
59b05e08 18
9ad4bbe8 19our $VERSION = '0.14';
59b05e08
JRT
20$VERSION = eval $VERSION; ## no critic
21
1e7b8681
JRT
22# Globals. Ick!
23my $NAMESPACE = $EMPTY;
24my @SITE_POLICIES = ();
25
26#-------------------------------------------------------------------------
27
28sub import {
29
30 my ( $class, %args ) = @_;
31 $NAMESPACE = $args{-namespace} || 'Perl::Critic::Policy';
32
33 eval {
34 require Module::Pluggable;
35 Module::Pluggable->import( search_path => $NAMESPACE, require => 1);
36 @SITE_POLICIES = plugins(); #Exported by Module::Pluggable
37 };
38
39
40 if ( $EVAL_ERROR ) {
41 croak qq{Can't load Policies from namespace '$NAMESPACE': $EVAL_ERROR};
42 }
43 elsif ( ! @SITE_POLICIES ) {
44 carp qq{No Policies found in namespace '$NAMESPACE'};
45 }
46
47 return 1;
48}
dff08b70 49
59b05e08
JRT
50#-------------------------------------------------------------------------
51
52sub new {
53
54 my ( $class, %args ) = @_;
55 my $self = bless {}, $class;
1e7b8681 56 $self->{_policies} = [];
dff08b70
JRT
57
58 # Set defaults
1e7b8681
JRT
59 my $profile_path = $args{-profile} || $EMPTY;
60 my $min_severity = $args{-severity} || $SEVERITY_HIGHEST;
61 my $excludes_ref = $args{-exclude} || []; #empty array
62 my $includes_ref = $args{-include} || []; #empty array
63
dff08b70
JRT
64
65 # Allow null config. This is useful for testing
66 return $self if $profile_path eq 'NONE';
67
c5d8050b 68 # Load user's profile.
dff08b70 69 my $profile_ref = _load_profile( $profile_path ) || {};
1e7b8681 70
c5d8050b 71 # Apply logic to decide if Policy should be loaded
4acf5ed2 72 for my $policy_long ( @SITE_POLICIES ) {
1e7b8681 73
4acf5ed2
JRT
74 my $policy_short = _short_name($policy_long, $NAMESPACE);
75 my $params = $profile_ref->{$policy_long} || $profile_ref->{$policy_short} || {};
c5d8050b
JRT
76
77 #Start by assuming the policy should be loaded
78 my $load_me = $TRUE;
79
80 #Don't load policy if it is negated in the profile
4acf5ed2 81 if ( exists $profile_ref->{"-$policy_short"} || exists $profile_ref->{"-$policy_long"} ) {
c5d8050b
JRT
82 $load_me = $FALSE;
83 }
84
85 #Don't load policy if it is below the severity threshold
4acf5ed2 86 my $severity = $params->{severity} || $policy_long->default_severity;
c5d8050b
JRT
87 if ( $severity < $min_severity ) {
88 $load_me = $FALSE;
89 }
90
91 #Do load if policy matches one of the inclusions patterns
4acf5ed2 92 if (any { $policy_long =~ m{ $_ }imx } @{ $includes_ref } ) {
c5d8050b
JRT
93 $load_me = $TRUE;
94 }
95
96 #But don't load if policy matches any of the exclusion patterns
4acf5ed2 97 if (any { $policy_long =~ m{ $_ }imx } @{ $excludes_ref } ) {
c5d8050b
JRT
98 $load_me = $FALSE;
99 }
100
101 #Now load (or not)
102 if( $load_me ){
4acf5ed2 103 $self->add_policy( -policy => $policy_long, -config => $params );
c5d8050b 104 }
59b05e08
JRT
105 }
106
107 #All done!
108 return $self;
109}
110
111#------------------------------------------------------------------------
59b05e08 112
dff08b70
JRT
113sub add_policy {
114
115 my ( $self, %args ) = @_;
116 my $policy = $args{-policy} || return;
9f1d5408 117 my $config_ref = $args{-config} || {};
dcdd89e8 118 my $severity = $config_ref->{severity};
1e7b8681 119 my $module_name = _long_name($policy, $NAMESPACE);
59b05e08 120
dff08b70 121 eval {
9f1d5408 122 my $policy_obj = $module_name->new( %{ $config_ref } );
4e98e72e
JRT
123
124 if( defined $severity ) {
125 my $normal_severity = _normalize_severity( $severity );
126 $policy_obj->set_severity( $normal_severity );
127 }
128
129 push @{ $self->{_policies} }, $policy_obj;
dff08b70
JRT
130 };
131
4e98e72e 132
dff08b70
JRT
133 if ($EVAL_ERROR) {
134 carp qq{Failed to create polcy '$policy': $EVAL_ERROR};
4e98e72e 135 return; #Not fatal!
59b05e08 136 }
dff08b70 137
4e98e72e 138
dff08b70 139 return $self;
59b05e08
JRT
140}
141
142#------------------------------------------------------------------------
143
dff08b70
JRT
144sub policies {
145 my $self = shift;
146 return $self->{_policies};
59b05e08
JRT
147}
148
149#------------------------------------------------------------------------
dff08b70
JRT
150# Begin PRIVATE methods
151
152sub _load_profile {
153
154 my $profile = shift || $EMPTY;
1e7b8681 155 my $ref_type = ref $profile || 'DEFAULT';
dff08b70 156
1e7b8681
JRT
157 my %handlers = (
158 SCALAR => \&_load_from_string,
159 ARRAY => \&_load_from_array,
160 HASH => \&_load_from_hash,
161 DEFAULT => \&_load_from_file,
162 );
163
164 my $handler_ref = $handlers{$ref_type};
165 croak qq{Can't create Config from $ref_type} if ! $handler_ref;
166 return $handler_ref->($profile);
167}
dff08b70 168
59b05e08
JRT
169#------------------------------------------------------------------------
170
dff08b70
JRT
171sub _load_from_file {
172 my $file = shift;
173 $file ||= find_profile_path() || return {};
174 croak qq{'$file' is not a file} if ! -f $file;
175 return Config::Tiny->read($file);
59b05e08
JRT
176}
177
178#------------------------------------------------------------------------
179
dff08b70
JRT
180sub _load_from_array {
181 my $array_ref = shift;
182 my $joined = join qq{\n}, @{ $array_ref };
183 return Config::Tiny->read_string( $joined );
59b05e08
JRT
184}
185
186#------------------------------------------------------------------------
187
dff08b70
JRT
188sub _load_from_string {
189 my $string = shift;
190 return Config::Tiny->read_string( ${ $string } );
59b05e08
JRT
191}
192
193#------------------------------------------------------------------------
194
dff08b70
JRT
195sub _load_from_hash {
196 my $hash_ref = shift;
197 return $hash_ref;
198}
199
200#-----------------------------------------------------------------------------
59b05e08 201
dff08b70 202sub _long_name {
1e7b8681 203 my ($module_name, $namespace) = @_;
dff08b70
JRT
204 if ( $module_name !~ m{ \A $namespace }mx ) {
205 $module_name = $namespace . q{::} . $module_name;
59b05e08 206 }
dff08b70
JRT
207 return $module_name;
208}
209
210sub _short_name {
1e7b8681 211 my ($module_name, $namespace) = @_;
dff08b70
JRT
212 $module_name =~ s{\A $namespace ::}{}mx;
213 return $module_name;
59b05e08
JRT
214}
215
216#----------------------------------------------------------------------------
4e98e72e
JRT
217
218sub _normalize_severity {
219 my $severity = abs int shift;
220 return $SEVERITY_HIGHEST if $severity > $SEVERITY_HIGHEST;
221 return $SEVERITY_LOWEST if $severity < $SEVERITY_LOWEST;
222 return $severity;
223}
6d9feae6 224
4e98e72e 225#----------------------------------------------------------------------------
59b05e08
JRT
226# Begin PUBLIC STATIC methods
227
228sub find_profile_path {
229
230 #Define default filename
231 my $rc_file = '.perlcriticrc';
232
233 #Check explicit environment setting
234 return $ENV{PERLCRITIC} if exists $ENV{PERLCRITIC};
235
236 #Check current directory
237 return $rc_file if -f $rc_file;
238
239 #Check usual environment vars
240 for my $var (qw(HOME USERPROFILE HOMESHARE)) {
1e7b8681 241 next if ! defined $ENV{$var};
59b05e08
JRT
242 my $path = File::Spec->catfile( $ENV{$var}, $rc_file );
243 return $path if -f $path;
244 }
245
246 #No profile found!
247 return;
248}
249
250#----------------------------------------------------------------------------
251
dff08b70 252sub site_policies {
1e7b8681 253 return @SITE_POLICIES;
59b05e08
JRT
254}
255
1e7b8681 256
dff08b70 257sub native_policies {
59b05e08 258 return qw(
dff08b70
JRT
259 Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr
260 Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect
261 Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval
262 Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep
263 Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap
264 Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction
265 Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless
266 Perl::Critic::Policy::CodeLayout::ProhibitHardTabs
267 Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins
268 Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists
d57c3647 269 Perl::Critic::Policy::CodeLayout::RequireTidyCode
dff08b70
JRT
270 Perl::Critic::Policy::CodeLayout::RequireTrailingCommas
271 Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse
272 Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops
273 Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls
274 Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks
275 Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks
276 Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators
277 Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles
278 Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect
d57c3647
JRT
279 Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen
280 Perl::Critic::Policy::Miscellanea::RequireRcsKeywords
dff08b70 281 Perl::Critic::Policy::Modules::ProhibitMultiplePackages
7e86d49a 282 Perl::Critic::Policy::Modules::ProhibitEvilModules
d57c3647 283 Perl::Critic::Policy::Modules::RequireEndWithOne
dff08b70
JRT
284 Perl::Critic::Policy::Modules::RequireExplicitPackage
285 Perl::Critic::Policy::Modules::RequireBarewordIncludes
286 Perl::Critic::Policy::Modules::RequireVersionVar
6c7e7956 287 Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames
dff08b70
JRT
288 Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs
289 Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars
40992ac4 290 Perl::Critic::Policy::Subroutines::ProhibitAmpersandSigils
dff08b70 291 Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef
af437b92 292 Perl::Critic::Policy::Subroutines::ProhibitExcessComplexity
40992ac4
JRT
293 Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms
294 Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes
d57c3647 295 Perl::Critic::Policy::Subroutines::RequireFinalReturn
0d522016 296 Perl::Critic::Policy::References::ProhibitDoubleSigils
dff08b70
JRT
297 Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting
298 Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching
e3117689
JRT
299 Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict
300 Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings
301 Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict
302 Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings
dff08b70
JRT
303 Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma
304 Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes
305 Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals
306 Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros
307 Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes
308 Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars
309 Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators
310 Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator
311 Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator
312 Perl::Critic::Policy::Variables::ProhibitLocalVars
b672fd9e 313 Perl::Critic::Policy::Variables::ProhibitMatchVars
dff08b70
JRT
314 Perl::Critic::Policy::Variables::ProhibitPackageVars
315 Perl::Critic::Policy::Variables::ProhibitPunctuationVars
59b05e08
JRT
316 );
317}
318
dff08b70 3191;
59b05e08
JRT
320
321#----------------------------------------------------------------------------
322
59b05e08
JRT
323__END__
324
325=pod
326
327=head1 NAME
328
1e7b8681 329Perl::Critic::Config - Find and load Perl::Critic user-preferences
59b05e08
JRT
330
331=head1 DESCRIPTION
332
333Perl::Critic::Config takes care of finding and processing
1e7b8681 334user-preferences for L<Perl::Critic>. The Config object defines which
59b05e08 335Policy modules will be loaded into the Perl::Critic engine and how
1e7b8681 336they should be configured. You should never really need to
b2c7354a 337instantiate Perl::Critic::Config directly because the Perl::Critic
1e7b8681 338constructor will do it for you.
59b05e08
JRT
339
340=head1 CONSTRUCTOR
341
342=over 8
343
a1f26155 344=item C<new( [ -profile =E<gt> $FILE, -severity =E<gt> $N, -include =E<gt> \@PATTERNS, -exclude =E<gt> \@PATTERNS ] )>
59b05e08
JRT
345
346Returns a reference to a new Perl::Critic::Config object, which is
347basically just a blessed hash of configuration parameters. There
348aren't any special methods for getting and setting individual values,
349so just treat it like an ordinary hash. All arguments are optional
350key-value pairs as follows:
351
352B<-profile> is a path to a configuration file. If C<$FILE> is not
353defined, Perl::Critic::Config attempts to find a F<.perlcriticrc>
354configuration file in the current directory, and then in your home
355directory. Alternatively, you can set the C<PERLCRITIC> environment
356variable to point to a file in another location. If a configuration
6bf9b465
JRT
357file can't be found, or if C<$FILE> is an empty string, then all
358Policies will be loaded with their default configuration. See
359L<"CONFIGURATION"> for more information.
1e7b8681
JRT
360
361B<-severity> is the minimum severity level. Only Policy modules that
362have a severity greater than C<$N> will be loaded into this Config.
363Severity values are integers ranging from 1 (least severe) to 5 (most
364severe). The default is 5. For a given C<-profile>, decreasing the
365C<-severity> will usually result in more Policy violations. Users can
366redefine the severity level for any Policy in their F<.perlcriticrc>
367file. See L<"CONFIGURATION"> for more information.
368
6bf9b465
JRT
369B<-include> is a reference to a list of string C<@PATTERNS>. Policies
370that match at least one C<m/$PATTERN/imx> will be loaded into this
371Config, irrespective of the severity settings. You can use it in
372conjunction with the C<-exclude> option. Note that C<-exclude> takes
373precedence over C<-include> when a Policy matches both patterns.
1e7b8681 374
6bf9b465
JRT
375B<-exclude> is a reference to a list of string C<@PATTERNS>. Polices
376that match at least one C<m/$PATTERN/imx> will not be loaded into this
377Config, irrespective of the severity settings. You can use it in
378conjunction with the C<-include> option. Note that C<-exclude> takes
379precedence over C<-include> when a Policy matches both patterns.
59b05e08
JRT
380
381=back
382
dff08b70
JRT
383=head1 METHODS
384
385=over 8
386
a1f26155 387=item C<add_policy( -policy =E<gt> $policy_name, -config =E<gt> \%config_hash )>
dff08b70 388
1e7b8681
JRT
389Loads a Policy object and adds into this Config. If the object
390cannot be instantiated, it will throw a warning and return a false
391value. Otherwise, it returns a reference to this Config. Arguments
392are key-value pairs as follows:
393
394B<-policy> is the name of a L<Perl::Critic::Policy> subclass
395module. The C<'Perl::Critic::Policy'> portion of the name can be
396omitted for brevity. This argument is required.
397
398B<-config> is an optional reference to a hash of Policy configuration
399parameters (Note that this is B<not> a Perl::Critic::Config object). The
400contents of this hash reference will be passed into to the constructor
401of the Policy module. See the documentation in the relevant Policy
402module for a description of the arguments it supports.
dff08b70 403
6d9feae6 404=item C<policies()>
dff08b70 405
1e7b8681
JRT
406Returns a list containing references to all the Policy objects that
407have been loaded into this Config. Objects will be in the order that
408they were loaded.
dff08b70
JRT
409
410=back
411
59b05e08
JRT
412=head1 SUBROUTINES
413
414Perl::Critic::Config has a few static subroutines that are used
415internally, but may be useful to you in some way.
416
417=over 8
418
6d9feae6 419=item C<find_profile_path()>
59b05e08
JRT
420
421Searches the C<PERLCRITIC> environment variable, the current
422directory, and you home directory (in that order) for a
423F<.perlcriticrc> file. If the file is found, the full path is
424returned. Otherwise, returns undef;
425
6d9feae6 426=item C<site_policies()>
59b05e08 427
dff08b70
JRT
428Returns a list of all the Policy modules that are currently installed
429in the Perl::Critic:Policy namespace. These will include modules that
430are distributed with Perl::Critic plus any third-party modules that
431have been installed.
59b05e08 432
6d9feae6 433=item C<native_policies()>
59b05e08 434
dff08b70
JRT
435Returns a list of all the Policy modules that have been distributed
436with Perl::Critic. Does not include any third-party modules.
59b05e08
JRT
437
438=back
439
1eaad119
JRT
440=head1 ADVANCED USAGE
441
442All the Policy modules that ship with Perl::Critic are in the
443C<"Perl::Critic::Policy"> namespace. To load modules from an alternate
444namespace, import Perl::Critic::Config using the C<-namespace> option
445like this:
446
447 use Perl::Critic::Config -namespace = 'Foo::Bar'; #Loads from Foo::Bar::*
448
449At the moment, only one alternate namespace may be specified. Unless
450Policy module names are fully qualified, Perl::Critic::Config assumes
451that all Policies are in the specified namespace. So if you want to
6bf9b465 452use Policies from multiple namespaces, you will need to use the full
1eaad119
JRT
453module name in your f<.perlcriticrc> file.
454
59b05e08
JRT
455=head1 CONFIGURATION
456
457The default configuration file is called F<.perlcriticrc>.
458Perl::Critic::Config will look for this file in the current directory
459first, and then in your home directory. Alternatively, you can set
460the PERLCRITIC environment variable to explicitly point to a different
461file in another location. If none of these files exist, and the
1e7b8681
JRT
462C<-profile> option is not given to the constructor, then all the
463modules that are found in the Perl::Critic::Policy namespace will be
464loaded with their default configuration.
59b05e08
JRT
465
466The format of the configuration file is a series of named sections
467that contain key-value pairs separated by '='. Comments should
468start with '#' and can be placed on a separate line or after the
469name-value pairs if you desire. The general recipe is a series of
470blocks like this:
471
472 [Perl::Critic::Policy::Category::PolicyName]
1e7b8681 473 severity = 1
59b05e08
JRT
474 arg1 = value1
475 arg2 = value2
476
477C<Perl::Critic::Policy::Category::PolicyName> is the full name of a
478module that implements the policy. The Policy modules distributed
479with Perl::Critic have been grouped into categories according to the
480table of contents in Damian Conway's book B<Perl Best Practices>. For
b2c7354a 481brevity, you can omit the C<'Perl::Critic::Policy'> part of the
6bf9b465 482module name.
59b05e08 483
1e7b8681
JRT
484C<severity> is the level of importance you wish to assign to the
485Policy. All Policy modules are defined with a default severity value
486ranging from 1 (least severe) to 5 (most severe). However, you may
487disagree with the default severity and choose to give it a higher or
488lower severity, based on your own coding philosophy.
59b05e08 489
6bf9b465
JRT
490The remaining key-value pairs are configuration parameters that will
491be passed into the constructor of that Policy. The constructors for
492most Policy modules do not support arguments, and those that do should
493have reasonable defaults. See the documentation on the appropriate
494Policy module for more details.
59b05e08 495
6bf9b465
JRT
496Instead of redefining the severity for a given Policy, you can
497completely disable a Policy by prepending a '-' to the name of the
498module in your configuration file. In this manner, the Policy will
499never be loaded, regardless of the C<-severity> given to the
500Perl::Critic::Config constructor.
59b05e08
JRT
501
502A simple configuration might look like this:
503
504 #--------------------------------------------------------------
1e7b8681 505 # I think these are really important, so always load them
59b05e08
JRT
506
507 [TestingAndDebugging::RequirePackageStricture]
1e7b8681 508 severity = 5
59b05e08
JRT
509
510 [TestingAndDebugging::RequirePackageWarnings]
1e7b8681 511 severity = 5
59b05e08
JRT
512
513 #--------------------------------------------------------------
1e7b8681 514 # I think these are less important, so only load when asked
59b05e08
JRT
515
516 [Variables::ProhibitPackageVars]
1e7b8681 517 severity = 2
59b05e08
JRT
518
519 [ControlStructures::ProhibitPostfixControls]
1e7b8681
JRT
520 allow = if unless #A policy-specific configuration
521 severity = 2
59b05e08
JRT
522
523 #--------------------------------------------------------------
1e7b8681 524 # I do not agree with these at all, so never load them
59b05e08
JRT
525
526 [-NamingConventions::ProhibitMixedCaseVars]
527 [-NamingConventions::ProhibitMixedCaseSubs]
528
1e7b8681
JRT
529 #--------------------------------------------------------------
530 # For all other Policies, I accept the default severity,
531 # so no additional configuration is required for them.
532
6bf9b465
JRT
533A few sample configuration files are included in this distribution
534under the F<t/samples> directory. The F<perlcriticrc.none> file
535demonstrates how to disable Policy modules. The
536F<perlcriticrc.levels> file demonstrates how to redefine the severity
537level for any given Policy module. The F<perlcriticrc.pbp> file
538configures Perl::Critic to load only Policies described in Damian
539Conway's book "Perl Best Practices."
540
59b05e08
JRT
541=head1 AUTHOR
542
543Jeffrey Ryan Thalhammer <thaljef@cpan.org>
544
545=head1 COPYRIGHT
546
c3c88e54 547Copyright (c) 2005-2006 Jeffrey Ryan Thalhammer. All rights reserved.
59b05e08
JRT
548
549This program is free software; you can redistribute it and/or modify
550it under the same terms as Perl itself. The full text of this license
551can be found in the LICENSE file included with this module.
552
553=cut