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