Login
Increased severity of StringyEval policy because I think it frequently
[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;
dff08b70 14use Module::Pluggable (search_path => ['Perl::Critic::Policy'], require => 1);
59b05e08
JRT
15use English qw(-no_match_vars);
16use List::MoreUtils qw(any none);
17use Perl::Critic::Utils;
dff08b70 18use Carp qw(carp croak);
59b05e08
JRT
19
20our $VERSION = '0.13';
21$VERSION = eval $VERSION; ## no critic
22
dff08b70
JRT
23#This finds all Perl::Critic::Policy::* modules and requires them.
24my @SITE_POLICIES = plugins(); #Imported from Module::Pluggable
25
59b05e08
JRT
26#-------------------------------------------------------------------------
27
28sub new {
29
30 my ( $class, %args ) = @_;
31 my $self = bless {}, $class;
dff08b70
JRT
32 $self->{_policies} = [];
33
34 # Set defaults
35 my $profile_path = $args{-profile} || $EMPTY;
36 my $min_priority = $args{-priority} || 1;
37 my $excludes_ref = $args{-exclude} || []; #empty array
38 my $includes_ref = $args{-include} || []; #empty array
39
40 # Allow null config. This is useful for testing
41 return $self if $profile_path eq 'NONE';
42
43 # Load user's profile, then filter and create Policies
44 my $profile_ref = _load_profile( $profile_path ) || {};
45 while ( my ( $policy, $params ) = each %{ $profile_ref } ) {
46 next if any { $policy =~ m{ $_ }imx } @{ $excludes_ref };
47 next if none { $policy =~ m{ $_ }imx } @{ $includes_ref };
48 next if ( $params->{priority} ||= 0 ) > $min_priority;
49 $self->add_policy( -policy => $policy, -config => $params );
59b05e08
JRT
50 }
51
52 #All done!
53 return $self;
54}
55
56#------------------------------------------------------------------------
59b05e08 57
dff08b70
JRT
58sub add_policy {
59
60 my ( $self, %args ) = @_;
61 my $policy = $args{-policy} || return;
62 my $config = $args{-config} || {};
63 my $module_name = _long_name($policy);
59b05e08 64
dff08b70
JRT
65 eval {
66 my $policy_obj = $module_name->new( %{$config} );
67 push @{ $self->{_policies} }, $policy_obj;
68 };
69
70 if ($EVAL_ERROR) {
71 carp qq{Failed to create polcy '$policy': $EVAL_ERROR};
72 return;
59b05e08 73 }
dff08b70
JRT
74
75 return $self;
59b05e08
JRT
76}
77
78#------------------------------------------------------------------------
79
dff08b70
JRT
80sub policies {
81 my $self = shift;
82 return $self->{_policies};
59b05e08
JRT
83}
84
85#------------------------------------------------------------------------
dff08b70
JRT
86# Begin PRIVATE methods
87
88sub _load_profile {
89
90 my $profile = shift || $EMPTY;
91 my $ref_type = ref $profile;
92
93 #Load profile in various ways
94 my $user_prefs = $ref_type eq 'SCALAR' ? _load_from_string( $profile )
95 : $ref_type eq 'ARRAY' ? _load_from_array( $profile )
96 : $ref_type eq 'HASH' ? _load_from_hash( $profile )
97 : _load_from_file( $profile );
98
99 #Apply profile
100 my %final = ();
101 for my $policy ( @SITE_POLICIES ) {
102 my $short_name = _short_name($policy);
103 next if exists $user_prefs->{"-$short_name"};
104 my $params = $user_prefs->{$short_name} || {};
105 $final{ $policy } = $params;
106 }
59b05e08 107
dff08b70 108 return \%final;
59b05e08
JRT
109}
110
111#------------------------------------------------------------------------
112
dff08b70
JRT
113sub _load_from_file {
114 my $file = shift;
115 $file ||= find_profile_path() || return {};
116 croak qq{'$file' is not a file} if ! -f $file;
117 return Config::Tiny->read($file);
59b05e08
JRT
118}
119
120#------------------------------------------------------------------------
121
dff08b70
JRT
122sub _load_from_array {
123 my $array_ref = shift;
124 my $joined = join qq{\n}, @{ $array_ref };
125 return Config::Tiny->read_string( $joined );
59b05e08
JRT
126}
127
128#------------------------------------------------------------------------
129
dff08b70
JRT
130sub _load_from_string {
131 my $string = shift;
132 return Config::Tiny->read_string( ${ $string } );
59b05e08
JRT
133}
134
135#------------------------------------------------------------------------
136
dff08b70
JRT
137sub _load_from_hash {
138 my $hash_ref = shift;
139 return $hash_ref;
140}
141
142#-----------------------------------------------------------------------------
59b05e08 143
dff08b70
JRT
144sub _long_name {
145 my $module_name = shift;
146 my $namespace = 'Perl::Critic::Policy';
147 if ( $module_name !~ m{ \A $namespace }mx ) {
148 $module_name = $namespace . q{::} . $module_name;
59b05e08 149 }
dff08b70
JRT
150 return $module_name;
151}
152
153sub _short_name {
154 my $module_name = shift;
155 my $namespace = 'Perl::Critic::Policy';
156 $module_name =~ s{\A $namespace ::}{}mx;
157 return $module_name;
59b05e08
JRT
158}
159
160#----------------------------------------------------------------------------
161# Begin PUBLIC STATIC methods
162
163sub find_profile_path {
164
165 #Define default filename
166 my $rc_file = '.perlcriticrc';
167
168 #Check explicit environment setting
169 return $ENV{PERLCRITIC} if exists $ENV{PERLCRITIC};
170
171 #Check current directory
172 return $rc_file if -f $rc_file;
173
174 #Check usual environment vars
175 for my $var (qw(HOME USERPROFILE HOMESHARE)) {
176 next if !defined $ENV{$var};
177 my $path = File::Spec->catfile( $ENV{$var}, $rc_file );
178 return $path if -f $path;
179 }
180
181 #No profile found!
182 return;
183}
184
185#----------------------------------------------------------------------------
186
dff08b70
JRT
187sub site_policies {
188 return @SITE_POLICIES
59b05e08
JRT
189}
190
dff08b70 191sub native_policies {
59b05e08 192 return qw(
dff08b70
JRT
193 Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr
194 Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect
195 Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval
196 Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep
197 Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap
198 Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction
199 Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless
200 Perl::Critic::Policy::CodeLayout::ProhibitHardTabs
201 Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins
202 Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists
203 Perl::Critic::Policy::CodeLayout::RequireTrailingCommas
204 Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse
205 Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops
206 Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls
207 Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks
208 Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks
209 Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators
210 Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles
211 Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect
212 Perl::Critic::Policy::Modules::ProhibitMultiplePackages
7e86d49a 213 Perl::Critic::Policy::Modules::ProhibitEvilModules
dff08b70
JRT
214 Perl::Critic::Policy::Modules::RequireExplicitPackage
215 Perl::Critic::Policy::Modules::RequireBarewordIncludes
216 Perl::Critic::Policy::Modules::RequireVersionVar
217 Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs
218 Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars
219 Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef
220 Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting
221 Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching
222 Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms
223 Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes
224 Perl::Critic::Policy::TestingAndDebugging::RequirePackageStricture
225 Perl::Critic::Policy::TestingAndDebugging::RequirePackageWarnings
226 Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma
227 Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes
228 Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals
229 Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros
230 Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes
231 Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars
232 Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators
233 Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator
234 Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator
235 Perl::Critic::Policy::Variables::ProhibitLocalVars
236 Perl::Critic::Policy::Variables::ProhibitPackageVars
237 Perl::Critic::Policy::Variables::ProhibitPunctuationVars
59b05e08
JRT
238 );
239}
240
dff08b70 2411;
59b05e08
JRT
242
243#----------------------------------------------------------------------------
244
59b05e08
JRT
245__END__
246
247=pod
248
249=head1 NAME
250
251Perl::Critic::Config - Load Perl::Critic user-preferences
252
253=head1 DESCRIPTION
254
255Perl::Critic::Config takes care of finding and processing
256user-preferences for L<Perl::Critic>. The Config dictates which
257Policy modules will be loaded into the Perl::Critic engine and how
258they should be configured. You should never need to instantiate
259Perl::Critic::Config directly as the L<Perl::Critic> constructor will
260do it for you.
261
262=head1 CONSTRUCTOR
263
264=over 8
265
266=item new ( [ -profile => $FILE, -priority => $N, -include => \@PATTERNS, -exclude => \@PATTERNS ] )
267
268Returns a reference to a new Perl::Critic::Config object, which is
269basically just a blessed hash of configuration parameters. There
270aren't any special methods for getting and setting individual values,
271so just treat it like an ordinary hash. All arguments are optional
272key-value pairs as follows:
273
274B<-profile> is a path to a configuration file. If C<$FILE> is not
275defined, Perl::Critic::Config attempts to find a F<.perlcriticrc>
276configuration file in the current directory, and then in your home
277directory. Alternatively, you can set the C<PERLCRITIC> environment
278variable to point to a file in another location. If a configuration
279file can't be found, or if C<$FILE> is an empty string, then it
280defaults to include all the Policy modules that ship with
281Perl::Critic. See L<"CONFIGURATION"> for more information.
282
283B<-priority> is the maximum priority value of Policies that should be
284added to the Perl::Critic::Config. 1 is the "highest" priority, and
285all numbers larger than 1 have "lower" priority. Once the
286user-preferences have been read from the C<-profile>, all Policies
287that are configured with a priority greater than C<$N> will be removed
288from this Config. For a given C<-profile>, increasing C<$N> will
289result in more Policy violations. The default C<-priority> is 1. See
290L<"CONFIGURATION"> for more information.
291
292B<-include> is a reference to a list of C<@PATTERNS>. Once the
293user-preferences have been read from the C<-profile>, all Policies
294that do not match at least one C<m/$PATTERN/imx> will be removed
295from this Config. Using the C<-include> option causes the <-priority>
296option to be ignored.
297
298B<-exclude> is a reference to a list of C<@PATTERNS>. Once the
299user-preferences have been read from the C<-profile>, all Policies
300that match at least one C<m/$PATTERN/imx> will be removed from
301this Config. Using the C<-exclude> option causes the <-priority>
302option to be ignored. The C<-exclude> patterns are applied after the
303<-include> patterns, therefore, the C<-exclude> patterns take
304precedence.
305
306=back
307
dff08b70
JRT
308=head1 METHODS
309
310=over 8
311
312=item add_policy( -policy => $policy_name, -config => \%config_hash )
313
314TODO: Document this mehtod
315
316=item policies( void )
317
318TODO: Document this method
319
320=back
321
59b05e08
JRT
322=head1 SUBROUTINES
323
324Perl::Critic::Config has a few static subroutines that are used
325internally, but may be useful to you in some way.
326
327=over 8
328
329=item find_profile_path( void )
330
331Searches the C<PERLCRITIC> environment variable, the current
332directory, and you home directory (in that order) for a
333F<.perlcriticrc> file. If the file is found, the full path is
334returned. Otherwise, returns undef;
335
dff08b70 336=item site_policies( void )
59b05e08 337
dff08b70
JRT
338Returns a list of all the Policy modules that are currently installed
339in the Perl::Critic:Policy namespace. These will include modules that
340are distributed with Perl::Critic plus any third-party modules that
341have been installed.
59b05e08 342
dff08b70 343=item native_policies( void )
59b05e08 344
dff08b70
JRT
345Returns a list of all the Policy modules that have been distributed
346with Perl::Critic. Does not include any third-party modules.
59b05e08
JRT
347
348=back
349
350=head1 CONFIGURATION
351
352The default configuration file is called F<.perlcriticrc>.
353Perl::Critic::Config will look for this file in the current directory
354first, and then in your home directory. Alternatively, you can set
355the PERLCRITIC environment variable to explicitly point to a different
356file in another location. If none of these files exist, and the
357C<-profile> option is not given to the constructor,
358Perl::Critic::Config defaults to inlucde all the policies that are
359shipped with Perl::Critic.
360
361The format of the configuration file is a series of named sections
362that contain key-value pairs separated by '='. Comments should
363start with '#' and can be placed on a separate line or after the
364name-value pairs if you desire. The general recipe is a series of
365blocks like this:
366
367 [Perl::Critic::Policy::Category::PolicyName]
368 priority = 1
369 arg1 = value1
370 arg2 = value2
371
372C<Perl::Critic::Policy::Category::PolicyName> is the full name of a
373module that implements the policy. The Policy modules distributed
374with Perl::Critic have been grouped into categories according to the
375table of contents in Damian Conway's book B<Perl Best Practices>. For
376brevity, you can ommit the C<'Perl::Critic::Policy'> part of the
377module name. All Policy modules must be a subclass of
378L<Perl::Critic::Policy>.
379
380C<priority> is the level of importance you wish to assign to this
381policy. 1 is the "highest" priority level, and all numbers greater
382than 1 have increasingly "lower" priority. Only those policies with a
383priority less than or equal to the C<-priority> value given to the
384constructor will be loaded. The priority can be an arbitrarily large
385positive integer. If the priority is not defined, it defaults to 1.
386
387The remaining key-value pairs are configuration parameters for that
388specific Policy and will be passed into the constructor of the
389L<Perl::Critic::Policy> subclass. The constructors for most Policy
390modules do not support arguments, and those that do should have
391reasonable defaults. See the documentation on the appropriate Policy
392module for more details.
393
394By default, all the policies that are distributed with Perl::Critic
395are added to the Config. Rather than assign a priority level to a
396Policy, you can simply "turn off" a Policy by prepending a '-' to the
397name of the module in the config file. In this manner, the Policy
398will never be loaded, regardless of the C<-priority> given to the
399constructor.
400
401
402A simple configuration might look like this:
403
404 #--------------------------------------------------------------
405 # These are really important, so always load them
406
407 [TestingAndDebugging::RequirePackageStricture]
408 priority = 1
409
410 [TestingAndDebugging::RequirePackageWarnings]
411 priority = 1
412
413 #--------------------------------------------------------------
414 # These are less important, so only load when asked
415
416 [Variables::ProhibitPackageVars]
417 priority = 2
418
419 [ControlStructures::ProhibitPostfixControls]
420 priority = 2
421
422 #--------------------------------------------------------------
423 # I do not agree with these, so never load them
424
425 [-NamingConventions::ProhibitMixedCaseVars]
426 [-NamingConventions::ProhibitMixedCaseSubs]
427
428=head1 AUTHOR
429
430Jeffrey Ryan Thalhammer <thaljef@cpan.org>
431
432=head1 COPYRIGHT
433
434Copyright (c) 2005 Jeffrey Ryan Thalhammer. All rights reserved.
435
436This program is free software; you can redistribute it and/or modify
437it under the same terms as Perl itself. The full text of this license
438can be found in the LICENSE file included with this module.
439
440=cut