####################################################################### # $URL: http://perlcritic.tigris.org/svn/perlcritic/tags/Perl-Critic-0.18/lib/Perl/Critic/Config.pm $ # $Date: 2006-07-16 22:15:05 -0700 (Sun, 16 Jul 2006) $ # $Author: thaljef $ # $Revision: 506 $ ######################################################################## package Perl::Critic::Config; use strict; use warnings; use File::Spec; use Config::Tiny; use English qw(-no_match_vars); use List::MoreUtils qw(any none); use Perl::Critic::Utils; use Carp qw(carp croak); our $VERSION = '0.18'; $VERSION = eval $VERSION; ## no critic # Globals. Ick! my $NAMESPACE = $EMPTY; my @SITE_POLICIES = (); my $TEST_MODE = 0; #------------------------------------------------------------------------- sub import { my ( $class, %args ) = @_; $NAMESPACE = $args{-namespace} || 'Perl::Critic::Policy'; $TEST_MODE ||= $args{-test}; eval { require Module::Pluggable; Module::Pluggable->import( search_path => $NAMESPACE, require => 1, inner => 0 ); @SITE_POLICIES = plugins(); #Exported by Module::Pluggable }; if ( $EVAL_ERROR ) { croak qq{Can't load Policies from namespace '$NAMESPACE': $EVAL_ERROR}; } elsif ( ! @SITE_POLICIES ) { carp qq{No Policies found in namespace '$NAMESPACE'}; } # In test mode, only load native policies, not third-party ones if ( $TEST_MODE && grep {m/\bblib\b/xms} @INC ) { require File::Spec; my %files = map { $_ => File::Spec->catdir(split m/::/xms, $_) . '.pm' } @SITE_POLICIES; @SITE_POLICIES = grep { $INC{$files{$_}} && $INC{$files{$_}} =~ m/\bblib\b/xms } @SITE_POLICIES; } return 1; } #------------------------------------------------------------------------- sub new { my ( $class, %args ) = @_; my $self = bless {}, $class; $self->{_policies} = []; # Set defaults my $profile_path = $args{-profile}; my $min_severity = $args{-severity} || $SEVERITY_HIGHEST; my $excludes_ref = $args{-exclude} || []; #empty array my $includes_ref = $args{-include} || []; #empty array # Allow null config. This is useful for testing return $self if defined $profile_path && $profile_path eq 'NONE'; # Load user's profile. my $profile_ref = _load_profile( $profile_path ) || {}; # Smell-test the user's profile. _screen_user_profile( $profile_ref, $NAMESPACE ); # Apply logic to decide if Policy should be loaded for my $policy_long ( @SITE_POLICIES ) { my $policy_short = _short_name($policy_long, $NAMESPACE); my $params = $profile_ref->{$policy_long} || $profile_ref->{$policy_short} || {}; #Start by assuming the policy should be loaded my $load_me = $TRUE; #Don't load policy if it does not comply with the current API if ( !$policy_long->can('default_severity') || !$policy_long->can('applies_to') ) { warn "Policy $policy_short does not comply with the current API, skipping"; $load_me = $FALSE; next; # don't perform any other tests. This one trumps the rest } #Don't load policy if it is negated in the profile if ( exists $profile_ref->{"-$policy_short"} || exists $profile_ref->{"-$policy_long"} ) { $load_me = $FALSE; } #Don't load policy if it is below the severity threshold my $severity = $params->{severity} || $policy_long->default_severity; if ( $severity < $min_severity ) { $load_me = $FALSE; } #Do load if policy matches one of the inclusions patterns if (any { $policy_long =~ m{ $_ }imx } @{ $includes_ref } ) { $load_me = $TRUE; } #But don't load if policy matches any of the exclusion patterns if (any { $policy_long =~ m{ $_ }imx } @{ $excludes_ref } ) { $load_me = $FALSE; } #Now load (or not) if( $load_me ){ $self->add_policy( -policy => $policy_long, -config => $params ); } } #All done! return $self; } #------------------------------------------------------------------------ sub add_policy { my ( $self, %args ) = @_; my $policy = $args{-policy} || return; my $config_ref = $args{-config} || {}; my $severity = $config_ref->{severity}; my $module_name = _long_name($policy, $NAMESPACE); eval { my $policy_obj = $module_name->new( %{ $config_ref } ); if( defined $severity ) { my $normal_severity = _normalize_severity( $severity ); $policy_obj->set_severity( $normal_severity ); } push @{ $self->{_policies} }, $policy_obj; }; if ($EVAL_ERROR) { carp qq{Failed to create policy '$policy': $EVAL_ERROR}; return; #Not fatal! } return $self; } #------------------------------------------------------------------------ sub policies { my $self = shift; return $self->{_policies}; } #------------------------------------------------------------------------ # Begin PRIVATE methods sub _load_profile { my ($profile) = (@_); return {} if defined $profile && $profile eq $EMPTY; my $ref_type = ref $profile || 'DEFAULT'; my %handlers = ( SCALAR => \&_load_from_string, ARRAY => \&_load_from_array, HASH => \&_load_from_hash, DEFAULT => \&_load_from_file, ); my $handler_ref = $handlers{$ref_type}; croak qq{Can't create Config from $ref_type} if ! $handler_ref; return $handler_ref->($profile); } #------------------------------------------------------------------------ sub _load_from_file { my $file = shift; $file ||= find_profile_path() || return {}; croak qq{'$file' is not a file} if ! -f $file; return Config::Tiny->read($file); } #------------------------------------------------------------------------ sub _load_from_array { my $array_ref = shift; my $joined = join qq{\n}, @{ $array_ref }; return Config::Tiny->read_string( $joined ); } #------------------------------------------------------------------------ sub _load_from_string { my $string = shift; return Config::Tiny->read_string( ${ $string } ); } #------------------------------------------------------------------------ sub _load_from_hash { my $hash_ref = shift; return $hash_ref; } #----------------------------------------------------------------------------- sub _long_name { my ($module_name, $namespace) = @_; if ( $module_name !~ m{ \A $namespace }mx ) { $module_name = $namespace . q{::} . $module_name; } return $module_name; } sub _short_name { my ($module_name, $namespace) = @_; $module_name =~ s{\A $namespace ::}{}mx; return $module_name; } #---------------------------------------------------------------------------- sub _normalize_severity { my $severity = abs int shift; return $SEVERITY_HIGHEST if $severity > $SEVERITY_HIGHEST; return $SEVERITY_LOWEST if $severity < $SEVERITY_LOWEST; return $severity; } #---------------------------------------------------------------------------- sub _screen_user_profile { my ($profile_ref, $namespace) = @_; for my $policy_name ( sort keys %{ $profile_ref } ) { next if _is_valid_policy( $policy_name, $namespace ); warn qq{Can't find policy module '$policy_name'\n}; } return 1; } sub _is_valid_policy { my ($policy_name, $namespace) = @_; $policy_name =~ s{\A \s* -}{}mx; $policy_name = _long_name($policy_name, $namespace); return any { $policy_name eq $_ } @SITE_POLICIES; } #---------------------------------------------------------------------------- # Begin PUBLIC STATIC methods sub find_profile_path { #Define default filename my $rc_file = '.perlcriticrc'; #Check explicit environment setting return $ENV{PERLCRITIC} if exists $ENV{PERLCRITIC}; #Check current directory return $rc_file if -f $rc_file; #Check home directory if ( my $home_dir = _find_home_dir() ) { my $path = File::Spec->catfile( $home_dir, $rc_file ); return $path if -f $path; } #No profile defined return; } sub _find_home_dir { #Try using File::HomeDir eval { require File::HomeDir }; if ( ! $EVAL_ERROR ) { return File::HomeDir->my_home(); } #Check usual environment vars for my $key (qw(HOME USERPROFILE HOMESHARE)) { next if ! defined $ENV{$key}; return $ENV{$key} if -d $ENV{$key}; } #No home directory defined return; } #---------------------------------------------------------------------------- sub site_policies { return @SITE_POLICIES; } # This list should be in alphabetic order but it's no longer critical sub native_policies { return qw( Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock Perl::Critic::Policy::ClassHierarchies::ProhibitAutoloading Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless Perl::Critic::Policy::CodeLayout::ProhibitHardTabs Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists Perl::Critic::Policy::CodeLayout::RequireTidyCode Perl::Critic::Policy::CodeLayout::RequireTrailingCommas Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks Perl::Critic::Policy::Documentation::RequirePodAtEnd Perl::Critic::Policy::Documentation::RequirePodSections Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect Perl::Critic::Policy::InputOutput::ProhibitReadlineInForLoop Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen Perl::Critic::Policy::InputOutput::RequireBracedFileHandleWithPrint Perl::Critic::Policy::Miscellanea::ProhibitFormats Perl::Critic::Policy::Miscellanea::ProhibitTies Perl::Critic::Policy::Miscellanea::RequireRcsKeywords Perl::Critic::Policy::Modules::ProhibitAutomaticExportation Perl::Critic::Policy::Modules::ProhibitEvilModules Perl::Critic::Policy::Modules::ProhibitMultiplePackages Perl::Critic::Policy::Modules::RequireBarewordIncludes Perl::Critic::Policy::Modules::RequireEndWithOne Perl::Critic::Policy::Modules::RequireExplicitPackage Perl::Critic::Policy::Modules::RequireVersionVar Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars Perl::Critic::Policy::References::ProhibitDoubleSigils Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching Perl::Critic::Policy::Subroutines::ProhibitAmpersandSigils Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms Perl::Critic::Policy::Subroutines::ProhibitExcessComplexity Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes Perl::Critic::Policy::Subroutines::ProtectPrivateSubs Perl::Critic::Policy::Subroutines::RequireFinalReturn Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes Perl::Critic::Policy::ValuesAndExpressions::ProhibitEscapedCharacters Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes Perl::Critic::Policy::ValuesAndExpressions::ProhibitVersionStrings Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations Perl::Critic::Policy::Variables::ProhibitLocalVars Perl::Critic::Policy::Variables::ProhibitMatchVars Perl::Critic::Policy::Variables::ProhibitPackageVars Perl::Critic::Policy::Variables::ProhibitPunctuationVars Perl::Critic::Policy::Variables::ProtectPrivateVars Perl::Critic::Policy::Variables::RequireInitializationForLocalVars ); } 1; #---------------------------------------------------------------------------- __END__ =pod =head1 NAME Perl::Critic::Config - Find and load Perl::Critic user-preferences =head1 DESCRIPTION Perl::Critic::Config takes care of finding and processing user-preferences for L<Perl::Critic>. The Config object defines which Policy modules will be loaded into the Perl::Critic engine and how they should be configured. You should never really need to instantiate Perl::Critic::Config directly because the Perl::Critic constructor will do it for you. =head1 CONSTRUCTOR =over 8 =item C<< new( [ -profile => $FILE, -severity => $N, -include => \@PATTERNS, -exclude => \@PATTERNS ] ) >> Returns a reference to a new Perl::Critic::Config object, which is basically just a blessed hash of configuration parameters. There aren't any special methods for getting and setting individual values, so just treat it like an ordinary hash. All arguments are optional key-value pairs as follows: B<-profile> is a path to a configuration file. If C<$FILE> is not defined, Perl::Critic::Config attempts to find a F<.perlcriticrc> configuration file in the current directory, and then in your home directory. Alternatively, you can set the C<PERLCRITIC> environment variable to point to a file in another location. If a configuration file can't be found, or if C<$FILE> is an empty string, then all Policies will be loaded with their default configuration. See L<"CONFIGURATION"> for more information. B<-severity> is the minimum severity level. Only Policy modules that have a severity greater than C<$N> will be loaded into this Config. Severity values are integers ranging from 1 (least severe) to 5 (most severe). The default is 5. For a given C<-profile>, decreasing the C<-severity> will usually result in more Policy violations. Users can redefine the severity level for any Policy in their F<.perlcriticrc> file. See L<"CONFIGURATION"> for more information. B<-include> is a reference to a list of string C<@PATTERNS>. Policies that match at least one C<m/$PATTERN/imx> will be loaded into this Config, irrespective of the severity settings. You can use it in conjunction with the C<-exclude> option. Note that C<-exclude> takes precedence over C<-include> when a Policy matches both patterns. B<-exclude> is a reference to a list of string C<@PATTERNS>. Polices that match at least one C<m/$PATTERN/imx> will not be loaded into this Config, irrespective of the severity settings. You can use it in conjunction with the C<-include> option. Note that C<-exclude> takes precedence over C<-include> when a Policy matches both patterns. =back =head1 METHODS =over 8 =item C<< add_policy( -policy => $policy_name, -config => \%config_hash ) >> Loads a Policy object and adds into this Config. If the object cannot be instantiated, it will throw a warning and return a false value. Otherwise, it returns a reference to this Config. Arguments are key-value pairs as follows: B<-policy> is the name of a L<Perl::Critic::Policy> subclass module. The C<'Perl::Critic::Policy'> portion of the name can be omitted for brevity. This argument is required. B<-config> is an optional reference to a hash of Policy configuration parameters (Note that this is B<not> a Perl::Critic::Config object). The contents of this hash reference will be passed into to the constructor of the Policy module. See the documentation in the relevant Policy module for a description of the arguments it supports. =item C<policies()> Returns a list containing references to all the Policy objects that have been loaded into this Config. Objects will be in the order that they were loaded. =back =head1 SUBROUTINES Perl::Critic::Config has a few static subroutines that are used internally, but may be useful to you in some way. =over 8 =item C<find_profile_path()> Searches the C<PERLCRITIC> environment variable, the current directory, and you home directory (in that order) for a F<.perlcriticrc> file. If the file is found, the full path is returned. Otherwise, returns undef; =item C<site_policies()> Returns a list of all the Policy modules that are currently installed in the Perl::Critic:Policy namespace. These will include modules that are distributed with Perl::Critic plus any third-party modules that have been installed. =item C<native_policies()> Returns a list of all the Policy modules that have been distributed with Perl::Critic. Does not include any third-party modules. =back =head1 ADVANCED USAGE All the Policy modules that ship with Perl::Critic are in the C<"Perl::Critic::Policy"> namespace. To load modules from an alternate namespace, import Perl::Critic::Config using the C<-namespace> option like this: use Perl::Critic::Config -namespace => 'Foo::Bar'; #Loads from Foo::Bar::* At the moment, only one alternate namespace may be specified. Unless Policy module names are fully qualified, Perl::Critic::Config assumes that all Policies are in the specified namespace. So if you want to use Policies from multiple namespaces, you will need to use the full module name in your F<.perlcriticrc> file. =head1 CONFIGURATION The default configuration file is called F<.perlcriticrc>. Perl::Critic::Config will look for this file in the current directory first, and then in your home directory. Alternatively, you can set the PERLCRITIC environment variable to explicitly point to a different file in another location. If none of these files exist, and the C<-profile> option is not given to the constructor, then all the modules that are found in the Perl::Critic::Policy namespace will be loaded with their default configuration. The format of the configuration file is a series of named sections that contain key-value pairs separated by '='. Comments should start with '#' and can be placed on a separate line or after the name-value pairs if you desire. The general recipe is a series of blocks like this: [Perl::Critic::Policy::Category::PolicyName] severity = 1 arg1 = value1 arg2 = value2 C<Perl::Critic::Policy::Category::PolicyName> is the full name of a module that implements the policy. The Policy modules distributed with Perl::Critic have been grouped into categories according to the table of contents in Damian Conway's book B<Perl Best Practices>. For brevity, you can omit the C<'Perl::Critic::Policy'> part of the module name. C<severity> is the level of importance you wish to assign to the Policy. All Policy modules are defined with a default severity value ranging from 1 (least severe) to 5 (most severe). However, you may disagree with the default severity and choose to give it a higher or lower severity, based on your own coding philosophy. The remaining key-value pairs are configuration parameters that will be passed into the constructor of that Policy. The constructors for most Policy modules do not support arguments, and those that do should have reasonable defaults. See the documentation on the appropriate Policy module for more details. Instead of redefining the severity for a given Policy, you can completely disable a Policy by prepending a '-' to the name of the module in your configuration file. In this manner, the Policy will never be loaded, regardless of the C<-severity> given to the Perl::Critic::Config constructor. A simple configuration might look like this: #-------------------------------------------------------------- # I think these are really important, so always load them [TestingAndDebugging::RequireUseStrict] severity = 5 [TestingAndDebugging::RequireUseWarnings] severity = 5 #-------------------------------------------------------------- # I think these are less important, so only load when asked [Variables::ProhibitPackageVars] severity = 2 [ControlStructures::ProhibitPostfixControls] allow = if unless #A policy-specific configuration severity = 2 #-------------------------------------------------------------- # I do not agree with these at all, so never load them [-NamingConventions::ProhibitMixedCaseVars] [-NamingConventions::ProhibitMixedCaseSubs] #-------------------------------------------------------------- # For all other Policies, I accept the default severity, # so no additional configuration is required for them. A few sample configuration files are included in this distribution under the F<t/samples> directory. The F<perlcriticrc.none> file demonstrates how to disable Policy modules. The F<perlcriticrc.levels> file demonstrates how to redefine the severity level for any given Policy module. The F<perlcriticrc.pbp> file configures Perl::Critic to load only Policies described in Damian Conway's book "Perl Best Practices." =head1 AUTHOR Jeffrey Ryan Thalhammer <thaljef@cpan.org> =head1 COPYRIGHT Copyright (c) 2005-2006 Jeffrey Ryan Thalhammer. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of this license can be found in the LICENSE file included with this module. =cut