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