git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/Config.pm

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/Config.pm $
   3 #     $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
   4 #   $Author: clonezone $
   5 # $Revision: 2489 $
   6 ##############################################################################
   7
   8 package Perl::Critic::Config;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use English qw(-no_match_vars);
  15 use Readonly;
  16
  17 use List::MoreUtils qw(any none apply);
  18 use Scalar::Util qw(blessed);
  19
  20 use Perl::Critic::Exception::AggregateConfiguration;
  21 use Perl::Critic::Exception::Configuration;
  22 use Perl::Critic::Exception::Configuration::Option::Global::ParameterValue;
  23 use Perl::Critic::Exception::Fatal::Internal qw{ throw_internal };
  24 use Perl::Critic::PolicyFactory;
  25 use Perl::Critic::Theme qw( $RULE_INVALID_CHARACTER_REGEX cook_rule );
  26 use Perl::Critic::UserProfile qw();
  27 use Perl::Critic::Utils qw{
  28     :booleans :characters :severities :internal_lookup :classification
  29 };
  30 use Perl::Critic::Utils::Constants qw{ :profile_strictness };
  31 use Perl::Critic::Utils::DataConversion qw{ boolean_to_number dor };
  32
  33 #-----------------------------------------------------------------------------
  34
  35 our $VERSION = '1.088';
  36
  37 #-----------------------------------------------------------------------------
  38
  39 Readonly::Scalar my $SINGLE_POLICY_CONFIG_KEY => 'single-policy';
  40
  41 #-----------------------------------------------------------------------------
  42 # Constructor
  43
  44 sub new {
  45
  46     my ( $class, %args ) = @_;
  47     my $self = bless {}, $class;
  48     $self->_init( %args );
  49     return $self;
  50 }
  51
  52 #-----------------------------------------------------------------------------
  53
  54 sub _init {
  55     my ( $self, %args ) = @_;
  56
  57     # -top or -theme imply that -severity is 1, unless it is already defined
  58     if ( defined $args{-top} || defined $args{-theme} ) {
  59         $args{-severity} ||= $SEVERITY_LOWEST;
  60     }
  61
  62     my $errors = Perl::Critic::Exception::AggregateConfiguration->new();
  63
  64     # Construct the UserProfile to get default options.
  65     my $profile_source  = $args{-profile}; #Can be file path or data struct
  66     my $profile =
  67         Perl::Critic::UserProfile->new( -profile => $profile_source );
  68     my $options_processor = $profile->options_processor();
  69     $self->{_profile} = $profile;
  70
  71     $self->_validate_and_save_profile_strictness(
  72         $args{'-profile-strictness'},
  73         $errors,
  74     );
  75
  76     # If given, these options should always have a true value.
  77     $self->_validate_and_save_regex(
  78         'include', $args{-include}, $options_processor->include(), $errors
  79     );
  80     $self->_validate_and_save_regex(
  81         'exclude', $args{-exclude}, $options_processor->exclude(), $errors
  82     );
  83     $self->_validate_and_save_regex(
  84         $SINGLE_POLICY_CONFIG_KEY,
  85         $args{ qq/-$SINGLE_POLICY_CONFIG_KEY/ },
  86         $options_processor->single_policy(),
  87         $errors,
  88     );
  89
  90     $self->_validate_and_save_verbosity($args{-verbose}, $errors);
  91     $self->_validate_and_save_severity($args{-severity}, $errors);
  92     $self->_validate_and_save_top($args{-top}, $errors);
  93
  94     # If given, these options can be true or false (but defined)
  95     # We normalize these to numeric values by multiplying them by 1;
  96     {
  97         $self->{_force} = boolean_to_number( dor( $args{-force}, $options_processor->force() ) );
  98         $self->{_only}  = boolean_to_number( dor( $args{-only},  $options_processor->only()  ) );
  99         $self->{_color} = boolean_to_number( dor( $args{-color}, $options_processor->color() ) );
 100         $self->{_criticism_fatal} =
 101           boolean_to_number(dor( $args{'-criticism_fatal'}, $options_processor->criticism_fatal() ) );
 102     }
 103
 104     $self->_validate_and_save_theme($args{-theme}, $errors);
 105
 106     # Construct a Factory with the Profile
 107     my $factory =
 108         Perl::Critic::PolicyFactory->new(
 109             -profile              => $profile,
 110             -errors               => $errors,
 111             '-profile-strictness' => $self->profile_strictness(),
 112         );
 113     $self->{_factory} = $factory;
 114
 115     # Initialize internal storage for Policies
 116     $self->{_policies} = [];
 117
 118     # "NONE" means don't load any policies
 119     if ( not defined $profile_source or $profile_source ne 'NONE' ) {
 120         # Heavy lifting here...
 121         $self->_load_policies($errors);
 122     }
 123
 124     if ( $errors->has_exceptions() ) {
 125         $errors->rethrow();
 126     }
 127
 128     return $self;
 129 }
 130
 131 #-----------------------------------------------------------------------------
 132
 133 sub add_policy {
 134
 135     my ( $self, %args ) = @_;
 136
 137     if ( not $args{-policy} ) {
 138         throw_internal q{The -policy argument is required};
 139     }
 140
 141     my $policy  = $args{-policy};
 142
 143     # If the -policy is already a blessed object, then just add it directly.
 144     if ( blessed $policy ) {
 145         $self->_add_policy_if_enabled($policy);
 146         return $self;
 147     }
 148
 149     # NOTE: The "-config" option is supported for backward compatibility.
 150     my $params = $args{-params} || $args{-config};
 151
 152     my $factory       = $self->{_factory};
 153     my $policy_object =
 154         $factory->create_policy(-name=>$policy, -params=>$params);
 155     $self->_add_policy_if_enabled($policy_object);
 156
 157     return $self;
 158 }
 159
 160 #-----------------------------------------------------------------------------
 161
 162 sub _add_policy_if_enabled {
 163     my ( $self, $policy_object ) = @_;
 164
 165     my $config = $policy_object->__get_config()
 166         or throw_internal
 167             q{Policy was not set up properly because it doesn't have }
 168                 . q{a value for its config attribute.};
 169
 170     if ( $policy_object->initialize_if_enabled( $config ) ) {
 171         push @{ $self->{_policies} }, $policy_object;
 172     }
 173
 174     return;
 175 }
 176
 177 #-----------------------------------------------------------------------------
 178
 179 sub _load_policies {
 180
 181     my ( $self, $errors ) = @_;
 182     my $factory  = $self->{_factory};
 183     my @policies = $factory->create_all_policies( $errors );
 184
 185     return if $errors->has_exceptions();
 186
 187     for my $policy ( @policies ) {
 188
 189         # If -single-policy is true, only load policies that match it
 190         if ( $self->single_policy() ) {
 191             if ( $self->_policy_is_single_policy( $policy ) ) {
 192                 $self->add_policy( -policy => $policy );
 193             }
 194             next;
 195         }
 196
 197         # To load, or not to load -- that is the question.
 198         my $load_me = $self->only() ? $FALSE : $TRUE;
 199
 200         ## no critic (ProhibitPostfixControls)
 201         $load_me = $FALSE if     $self->_policy_is_disabled( $policy );
 202         $load_me = $TRUE  if     $self->_policy_is_enabled( $policy );
 203         $load_me = $FALSE if     $self->_policy_is_unimportant( $policy );
 204         $load_me = $FALSE if not $self->_policy_is_thematic( $policy );
 205         $load_me = $TRUE  if     $self->_policy_is_included( $policy );
 206         $load_me = $FALSE if     $self->_policy_is_excluded( $policy );
 207
 208
 209         next if not $load_me;
 210         $self->add_policy( -policy => $policy );
 211     }
 212
 213     # When using -single-policy, only one policy should ever be loaded.
 214     if ($self->single_policy() && scalar $self->policies() != 1) {
 215         $self->_add_single_policy_exception_to($errors);
 216     }
 217
 218     return;
 219 }
 220
 221 #-----------------------------------------------------------------------------
 222
 223 sub _policy_is_disabled {
 224     my ($self, $policy) = @_;
 225     my $profile = $self->_profile();
 226     return $profile->policy_is_disabled( $policy );
 227 }
 228
 229 #-----------------------------------------------------------------------------
 230
 231 sub _policy_is_enabled {
 232     my ($self, $policy) = @_;
 233     my $profile = $self->_profile();
 234     return $profile->policy_is_enabled( $policy );
 235 }
 236
 237 #-----------------------------------------------------------------------------
 238
 239 sub _policy_is_thematic {
 240     my ($self, $policy) = @_;
 241     my $theme = $self->theme();
 242     return $theme->policy_is_thematic( -policy => $policy );
 243 }
 244
 245 #-----------------------------------------------------------------------------
 246
 247 sub _policy_is_unimportant {
 248     my ($self, $policy) = @_;
 249     my $policy_severity = $policy->get_severity();
 250     my $min_severity    = $self->{_severity};
 251     return $policy_severity < $min_severity;
 252 }
 253
 254 #-----------------------------------------------------------------------------
 255
 256 sub _policy_is_included {
 257     my ($self, $policy) = @_;
 258     my $policy_long_name = ref $policy;
 259     my @inclusions  = $self->include();
 260     return any { $policy_long_name =~ m/$_/imx } @inclusions;
 261 }
 262
 263 #-----------------------------------------------------------------------------
 264
 265 sub _policy_is_excluded {
 266     my ($self, $policy) = @_;
 267     my $policy_long_name = ref $policy;
 268     my @exclusions  = $self->exclude();
 269     return any { $policy_long_name =~ m/$_/imx } @exclusions;
 270 }
 271
 272 #-----------------------------------------------------------------------------
 273
 274 sub _policy_is_single_policy {
 275     my ($self, $policy) = @_;
 276
 277     my @patterns = $self->single_policy();
 278     return if not @patterns;
 279
 280     my $policy_long_name = ref $policy;
 281     return any { $policy_long_name =~ m/$_/imx } @patterns;
 282 }
 283
 284 #-----------------------------------------------------------------------------
 285
 286 sub _new_global_value_exception {
 287     my ($self, @args) = @_;
 288
 289     return
 290         Perl::Critic::Exception::Configuration::Option::Global::ParameterValue
 291             ->new(@args);
 292 }
 293
 294 #-----------------------------------------------------------------------------
 295
 296 sub _add_single_policy_exception_to {
 297     my ($self, $errors) = @_;
 298
 299     my $message_suffix = $EMPTY;
 300     my $patterns = join q{", "}, $self->single_policy();
 301
 302     if (scalar $self->policies() == 0) {
 303         $message_suffix =
 304             q{did not match any policies (in combination with }
 305                 . q{other policy restrictions).};
 306     }
 307     else {
 308         $message_suffix  = qq{matched multiple policies:\n\t};
 309         $message_suffix .= join qq{,\n\t}, apply { chomp } sort $self->policies();
 310     }
 311
 312     $errors->add_exception(
 313         $self->_new_global_value_exception(
 314             option_name     => $SINGLE_POLICY_CONFIG_KEY,
 315             option_value    => $patterns,
 316             message_suffix  => $message_suffix,
 317         )
 318     );
 319
 320     return;
 321 }
 322
 323 #-----------------------------------------------------------------------------
 324
 325 sub _validate_and_save_regex {
 326     my ($self, $option_name, $args_value, $default_value, $errors) = @_;
 327
 328     my $full_option_name;
 329     my $source;
 330     my @regexes;
 331
 332     if ($args_value) {
 333         $full_option_name = "-$option_name";
 334
 335         if (ref $args_value) {
 336             @regexes = @{ $args_value };
 337         }
 338         else {
 339             @regexes = ( $args_value );
 340         }
 341     }
 342
 343     if (not @regexes) {
 344         $full_option_name = $option_name;
 345         $source = $self->_profile()->source();
 346
 347         if (ref $default_value) {
 348             @regexes = @{ $default_value };
 349         }
 350         elsif ($default_value) {
 351             @regexes = ( $default_value );
 352         }
 353     }
 354
 355     my $found_errors;
 356     foreach my $regex (@regexes) {
 357         eval { my $test = qr/$regex/imx; }
 358             or do {
 359                 my $cleaned_error = $EVAL_ERROR || '<unknown reason>';
 360                 $cleaned_error =~
 361                     s/ [ ] at [ ] .* Config [.] pm [ ] line [ ] \d+ [.] \n? \z/./xms;
 362
 363                 $errors->add_exception(
 364                     $self->_new_global_value_exception(
 365                         option_name     => $option_name,
 366                         option_value    => $regex,
 367                         source          => $source,
 368                         message_suffix  => qq{is not valid: $cleaned_error},
 369                     )
 370                 );
 371
 372                 $found_errors = 1;
 373             }
 374     }
 375
 376     if (not $found_errors) {
 377         my $option_key = $option_name;
 378         $option_key =~ s/ - /_/xmsg;
 379
 380         $self->{"_$option_key"} = \@regexes;
 381     }
 382
 383     return;
 384 }
 385
 386 #-----------------------------------------------------------------------------
 387
 388 sub _validate_and_save_profile_strictness {
 389     my ($self, $args_value, $errors) = @_;
 390
 391     my $option_name;
 392     my $source;
 393     my $profile_strictness;
 394
 395     if ($args_value) {
 396         $option_name = '-profile-strictness';
 397         $profile_strictness = $args_value;
 398     }
 399     else {
 400         $option_name = 'profile-strictness';
 401
 402         my $profile = $self->_profile();
 403         $source = $profile->source();
 404         $profile_strictness = $profile->options_processor()->profile_strictness();
 405     }
 406
 407     if ( not $PROFILE_STRICTNESSES{$profile_strictness} ) {
 408         $errors->add_exception(
 409             $self->_new_global_value_exception(
 410                 option_name     => $option_name,
 411                 option_value    => $profile_strictness,
 412                 source          => $source,
 413                 message_suffix  => q{is not one of "}
 414                     . join ( q{", "}, (sort keys %PROFILE_STRICTNESSES) )
 415                     . q{".},
 416             )
 417         );
 418
 419         $profile_strictness = $PROFILE_STRICTNESS_FATAL;
 420     }
 421
 422     $self->{_profile_strictness} = $profile_strictness;
 423
 424     return;
 425 }
 426
 427 #-----------------------------------------------------------------------------
 428
 429 sub _validate_and_save_verbosity {
 430     my ($self, $args_value, $errors) = @_;
 431
 432     my $option_name;
 433     my $source;
 434     my $verbosity;
 435
 436     if ($args_value) {
 437         $option_name = '-verbose';
 438         $verbosity = $args_value;
 439     }
 440     else {
 441         $option_name = 'verbose';
 442
 443         my $profile = $self->_profile();
 444         $source = $profile->source();
 445         $verbosity = $profile->options_processor()->verbose();
 446     }
 447
 448     if (
 449             is_integer($verbosity)
 450         and not is_valid_numeric_verbosity($verbosity)
 451     ) {
 452         $errors->add_exception(
 453             $self->_new_global_value_exception(
 454                 option_name     => $option_name,
 455                 option_value    => $verbosity,
 456                 source          => $source,
 457                 message_suffix  =>
 458                     'is not the number of one of the pre-defined verbosity formats.',
 459             )
 460         );
 461     }
 462     else {
 463         $self->{_verbose} = $verbosity;
 464     }
 465
 466     return;
 467 }
 468
 469 #-----------------------------------------------------------------------------
 470
 471 sub _validate_and_save_severity {
 472     my ($self, $args_value, $errors) = @_;
 473
 474     my $option_name;
 475     my $source;
 476     my $severity;
 477
 478     if ($args_value) {
 479         $option_name = '-severity';
 480         $severity = $args_value;
 481     }
 482     else {
 483         $option_name = 'severity';
 484
 485         my $profile = $self->_profile();
 486         $source = $profile->source();
 487         $severity = $profile->options_processor()->severity();
 488     }
 489
 490     if ( is_integer($severity) ) {
 491         if (
 492             $severity >= $SEVERITY_LOWEST and $severity <= $SEVERITY_HIGHEST
 493         ) {
 494             $self->{_severity} = $severity;
 495         }
 496         else {
 497             $errors->add_exception(
 498                 $self->_new_global_value_exception(
 499                     option_name     => $option_name,
 500                     option_value    => $severity,
 501                     source          => $source,
 502                     message_suffix  =>
 503                         "is not between $SEVERITY_LOWEST (low) and $SEVERITY_HIGHEST (high).",
 504                 )
 505             );
 506         }
 507     }
 508     elsif ( not any { $_ eq lc $severity } @SEVERITY_NAMES ) {
 509         $errors->add_exception(
 510             $self->_new_global_value_exception(
 511                 option_name     => $option_name,
 512                 option_value    => $severity,
 513                 source          => $source,
 514                 message_suffix  =>
 515                     q{is not one of the valid severity names: "}
 516                         . join (q{", "}, @SEVERITY_NAMES)
 517                         . q{".},
 518             )
 519         );
 520     }
 521     else {
 522         $self->{_severity} = severity_to_number($severity);
 523     }
 524
 525     return;
 526 }
 527
 528 #-----------------------------------------------------------------------------
 529
 530 sub _validate_and_save_top {
 531     my ($self, $args_value, $errors) = @_;
 532
 533     my $option_name;
 534     my $source;
 535     my $top;
 536
 537     if (defined $args_value and $args_value ne q{}) {
 538         $option_name = '-top';
 539         $top = $args_value;
 540     }
 541     else {
 542         $option_name = 'top';
 543
 544         my $profile = $self->_profile();
 545         $source = $profile->source();
 546         $top = $profile->options_processor()->top();
 547     }
 548
 549     if ( is_integer($top) and $top >= 0 ) {
 550         $self->{_top} = $top;
 551     }
 552     else {
 553         $errors->add_exception(
 554             $self->_new_global_value_exception(
 555                 option_name     => $option_name,
 556                 option_value    => $top,
 557                 source          => $source,
 558                 message_suffix  => q{is not a non-negative integer.},
 559             )
 560         );
 561     }
 562
 563     return;
 564 }
 565
 566 #-----------------------------------------------------------------------------
 567
 568 sub _validate_and_save_theme {
 569     my ($self, $args_value, $errors) = @_;
 570
 571     my $option_name;
 572     my $source;
 573     my $theme_rule;
 574
 575     if ($args_value) {
 576         $option_name = '-theme';
 577         $theme_rule = $args_value;
 578     }
 579     else {
 580         $option_name = 'theme';
 581
 582         my $profile = $self->_profile();
 583         $source = $profile->source();
 584         $theme_rule = $profile->options_processor()->theme();
 585     }
 586
 587     if ( $theme_rule =~ m/$RULE_INVALID_CHARACTER_REGEX/xms ) {
 588         my $bad_character = $1;
 589
 590         $errors->add_exception(
 591             $self->_new_global_value_exception(
 592                 option_name     => $option_name,
 593                 option_value    => $theme_rule,
 594                 source          => $source,
 595                 message_suffix  =>
 596                     qq{contains an illegal character ("$bad_character").},
 597             )
 598         );
 599     }
 600     else {
 601         my $rule_as_code = cook_rule($theme_rule);
 602         $rule_as_code =~ s/ [\w\d]+ / 1 /gxms;
 603
 604         # eval of an empty string does not reset $@ in Perl 5.6.
 605         local $EVAL_ERROR = $EMPTY;
 606         eval $rule_as_code; ## no critic (ProhibitStringyEval, RequireCheckingReturnValueOfEval)
 607
 608         if ($EVAL_ERROR) {
 609             $errors->add_exception(
 610                 $self->_new_global_value_exception(
 611                     option_name     => $option_name,
 612                     option_value    => $theme_rule,
 613                     source          => $source,
 614                     message_suffix  => q{is not syntactically valid.},
 615                 )
 616             );
 617         }
 618         else {
 619             eval {
 620                 $self->{_theme} =
 621                     Perl::Critic::Theme->new( -rule => $theme_rule );
 622             }
 623                 or do {
 624                     $errors->add_exception_or_rethrow( $EVAL_ERROR );
 625                 };
 626         }
 627     }
 628
 629     return;
 630 }
 631
 632 #-----------------------------------------------------------------------------
 633 # Begin ACCESSSOR methods
 634
 635 sub _profile {
 636     my $self = shift;
 637     return $self->{_profile};
 638 }
 639
 640 #-----------------------------------------------------------------------------
 641
 642 sub policies {
 643     my $self = shift;
 644     return @{ $self->{_policies} };
 645 }
 646
 647 #-----------------------------------------------------------------------------
 648
 649 sub exclude {
 650     my $self = shift;
 651     return @{ $self->{_exclude} };
 652 }
 653
 654 #-----------------------------------------------------------------------------
 655
 656 sub force {
 657     my $self = shift;
 658     return $self->{_force};
 659 }
 660
 661 #-----------------------------------------------------------------------------
 662
 663 sub include {
 664     my $self = shift;
 665     return @{ $self->{_include} };
 666 }
 667
 668 #-----------------------------------------------------------------------------
 669
 670 sub only {
 671     my $self = shift;
 672     return $self->{_only};
 673 }
 674
 675 #-----------------------------------------------------------------------------
 676
 677 sub profile_strictness {
 678     my $self = shift;
 679     return $self->{_profile_strictness};
 680 }
 681
 682 #-----------------------------------------------------------------------------
 683
 684 sub severity {
 685     my $self = shift;
 686     return $self->{_severity};
 687 }
 688
 689 #-----------------------------------------------------------------------------
 690
 691 sub single_policy {
 692     my $self = shift;
 693     return @{ $self->{_single_policy} };
 694 }
 695
 696 #-----------------------------------------------------------------------------
 697
 698 sub theme {
 699     my $self = shift;
 700     return $self->{_theme};
 701 }
 702
 703 #-----------------------------------------------------------------------------
 704
 705 sub top {
 706     my $self = shift;
 707     return $self->{_top};
 708 }
 709
 710 #-----------------------------------------------------------------------------
 711
 712 sub verbose {
 713     my $self = shift;
 714     return $self->{_verbose};
 715 }
 716
 717 #-----------------------------------------------------------------------------
 718
 719 sub color {
 720     my $self = shift;
 721     return $self->{_color};
 722 }
 723
 724 #-----------------------------------------------------------------------------
 725
 726 sub criticism_fatal {
 727     my $self = shift;
 728     return $self->{_criticism_fatal};
 729 }
 730
 731 #-----------------------------------------------------------------------------
 732
 733 sub site_policy_names {
 734     return Perl::Critic::PolicyFactory::site_policy_names();
 735 }
 736
 737 1;
 738
 739 #-----------------------------------------------------------------------------
 740
 741 __END__
 742
 743 =pod
 744
 745 =for stopwords -params INI-style
 746
 747 =head1 NAME
 748
 749 Perl::Critic::Config - The final derived Perl::Critic configuration, combined from any profile file and command-line parameters.
 750
 751 =head1 DESCRIPTION
 752
 753 Perl::Critic::Config takes care of finding and processing
 754 user-preferences for L<Perl::Critic>.  The Config object defines which
 755 Policy modules will be loaded into the Perl::Critic engine and how
 756 they should be configured.  You should never really need to
 757 instantiate Perl::Critic::Config directly because the Perl::Critic
 758 constructor will do it for you.
 759
 760 =head1 CONSTRUCTOR
 761
 762 =over 8
 763
 764 =item C<< new( [ -profile => $FILE, -severity => $N, -theme => $string, -include => \@PATTERNS, -exclude => \@PATTERNS, -single-policy => $PATTERN, -top => $N, -only => $B, -profile-strictness => $PROFILE_STRICTNESS_{WARN|FATAL|QUIET}, -force => $B, -verbose => $N, -color => $B, -criticism-fatal => $B] ) >>
 765
 766 =item C<< new() >>
 767
 768 Returns a reference to a new Perl::Critic::Config object.  The default
 769 value for all arguments can be defined in your F<.perlcriticrc> file.
 770 See the L<"CONFIGURATION"> section for more information about that.
 771 All arguments are optional key-value pairs as follows:
 772
 773 B<-profile> is a path to a configuration file. If C<$FILE> is not
 774 defined, Perl::Critic::Config attempts to find a F<.perlcriticrc>
 775 configuration file in the current directory, and then in your home
 776 directory.  Alternatively, you can set the C<PERLCRITIC> environment
 777 variable to point to a file in another location.  If a configuration
 778 file can't be found, or if C<$FILE> is an empty string, then all
 779 Policies will be loaded with their default configuration.  See
 780 L<"CONFIGURATION"> for more information.
 781
 782 B<-severity> is the minimum severity level.  Only Policy modules that
 783 have a severity greater than C<$N> will be loaded into this Config.
 784 Severity values are integers ranging from 1 (least severe) to 5 (most
 785 severe).  The default is 5.  For a given C<-profile>, decreasing the
 786 C<-severity> will usually result in more Policy violations.  Users can
 787 redefine the severity level for any Policy in their F<.perlcriticrc>
 788 file.  See L<"CONFIGURATION"> for more information.
 789
 790 B<-theme> is special string that defines a set of Policies based on
 791 their respective themes.  If C<-theme> is given, only policies that
 792 are members of that set will be loaded.  See the L<"POLICY THEMES">
 793 section for more information about themes.  Unless the C<-severity>
 794 option is explicitly given, setting C<-theme> causes the C<-severity>
 795 to be set to 1.
 796
 797 B<-include> is a reference to a list of string C<@PATTERNS>.  Policies
 798 that match at least one C<m/$PATTERN/imx> will be loaded into this
 799 Config, irrespective of the severity settings.  You can use it in
 800 conjunction with the C<-exclude> option.  Note that C<-exclude> takes
 801 precedence over C<-include> when a Policy matches both patterns.
 802
 803 B<-exclude> is a reference to a list of string C<@PATTERNS>.  Polices
 804 that match at least one C<m/$PATTERN/imx> will not be loaded into this
 805 Config, irrespective of the severity settings.  You can use it in
 806 conjunction with the C<-include> option.  Note that C<-exclude> takes
 807 precedence over C<-include> when a Policy matches both patterns.
 808
 809 B<-single-policy> is a string C<PATTERN>.  Only the policy that matches
 810 C<m/$PATTERN/imx> will be used.  This value overrides the
 811 C<-severity>, C<-theme>, C<-include>, C<-exclude>, and C<-only>
 812 options.
 813
 814 B<-top> is the maximum number of Violations to return when ranked by
 815 their severity levels.  This must be a positive integer.  Violations
 816 are still returned in the order that they occur within the file.
 817 Unless the C<-severity> option is explicitly given, setting C<-top>
 818 silently causes the C<-severity> to be set to 1.
 819
 820 B<-only> is a boolean value.  If set to a true value, Perl::Critic
 821 will only choose from Policies that are mentioned in the user's
 822 profile.  If set to a false value (which is the default), then
 823 Perl::Critic chooses from all the Policies that it finds at your site.
 824
 825 B<-profile-strictness> is an enumerated value, one of
 826 L<Perl::Critic::Utils::Constants/"$PROFILE_STRICTNESS_WARN"> (the
 827 default),
 828 L<Perl::Critic::Utils::Constants/"$PROFILE_STRICTNESS_FATAL">, and
 829 L<Perl::Critic::Utils::Constants/"$PROFILE_STRICTNESS_QUIET">.  If set
 830 to L<Perl::Critic::Utils::Constants/"$PROFILE_STRICTNESS_FATAL">,
 831 Perl::Critic will make certain warnings about problems found in a
 832 F<.perlcriticrc> or file specified via the B<-profile> option fatal.
 833 For example, Perl::Critic normally only C<warn>s about profiles
 834 referring to non-existent Policies, but this value makes this
 835 situation fatal.  Correspondingly,
 836 L<Perl::Critic::Utils::Constants/"$PROFILE_STRICTNESS_QUIET"> makes
 837 Perl::Critic shut up about these things.
 838
 839 B<-force> controls whether Perl::Critic observes the magical C<"## no
 840 critic"> pseudo-pragmas in your code.  If set to a true value,
 841 Perl::Critic will analyze all code.  If set to a false value (which is
 842 the default) Perl::Critic will ignore code that is tagged with these
 843 comments.  See L<Perl::Critic/"BENDING THE RULES"> for more
 844 information.
 845
 846 B<-verbose> can be a positive integer (from 1 to 10), or a literal
 847 format specification.  See L<Perl::Critic::Violations> for an
 848 explanation of format specifications.
 849
 850 B<-color> is not used by Perl::Critic but is provided for the benefit
 851 of L<perlcritic>.
 852
 853 B<-criticism-fatal> is not used by Perl::Critic but is provided for the benefit
 854 of L<criticism>.
 855
 856
 857
 858 =back
 859
 860 =head1 METHODS
 861
 862 =over 8
 863
 864 =item C<< add_policy( -policy => $policy_name, -params => \%param_hash ) >>
 865
 866 Creates a Policy object and loads it into this Config.  If the object
 867 cannot be instantiated, it will throw a fatal exception.  Otherwise,
 868 it returns a reference to this Critic.
 869
 870 B<-policy> is the name of a L<Perl::Critic::Policy> subclass
 871 module.  The C<'Perl::Critic::Policy'> portion of the name can be
 872 omitted for brevity.  This argument is required.
 873
 874 B<-params> is an optional reference to a hash of Policy parameters.
 875 The contents of this hash reference will be passed into to the
 876 constructor of the Policy module.  See the documentation in the
 877 relevant Policy module for a description of the arguments it supports.
 878
 879 =item C< policies() >
 880
 881 Returns a list containing references to all the Policy objects that
 882 have been loaded into this Config.  Objects will be in the order that
 883 they were loaded.
 884
 885 =item C< exclude() >
 886
 887 Returns the value of the C<-exclude> attribute for this Config.
 888
 889 =item C< include() >
 890
 891 Returns the value of the C<-include> attribute for this Config.
 892
 893 =item C< force() >
 894
 895 Returns the value of the C<-force> attribute for this Config.
 896
 897 =item C< only() >
 898
 899 Returns the value of the C<-only> attribute for this Config.
 900
 901 =item C< profile_strictness() >
 902
 903 Returns the value of the C<-profile-strictness> attribute for this
 904 Config.
 905
 906 =item C< severity() >
 907
 908 Returns the value of the C<-severity> attribute for this Config.
 909
 910 =item C< single_policy() >
 911
 912 Returns the value of the C<-single-policy> attribute for this Config.
 913
 914 =item C< theme() >
 915
 916 Returns the L<Perl::Critic::Theme> object that was created for
 917 this Config.
 918
 919 =item C< top() >
 920
 921 Returns the value of the C<-top> attribute for this Config.
 922
 923 =item C< verbose() >
 924
 925 Returns the value of the C<-verbose> attribute for this Config.
 926
 927 =item C< color() >
 928
 929 Returns the value of the C<-color> attribute for this Config.
 930
 931 =item C< criticism_fatal() >
 932
 933 Returns the value of the C<-criticsm-fatal> attribute for this Config.
 934
 935 =back
 936
 937 =head1 SUBROUTINES
 938
 939 Perl::Critic::Config has a few static subroutines that are used
 940 internally, but may be useful to you in some way.
 941
 942 =over 8
 943
 944 =item C<site_policy_names()>
 945
 946 Returns a list of all the Policy modules that are currently installed
 947 in the Perl::Critic:Policy namespace.  These will include modules that
 948 are distributed with Perl::Critic plus any third-party modules that
 949 have been installed.
 950
 951 =back
 952
 953 =head1 CONFIGURATION
 954
 955 Most of the settings for Perl::Critic and each of the Policy modules
 956 can be controlled by a configuration file.  The default configuration
 957 file is called F<.perlcriticrc>.  L<Perl::Critic::Config> will look
 958 for this file in the current directory first, and then in your home
 959 directory.  Alternatively, you can set the C<PERLCRITIC> environment
 960 variable to explicitly point to a different file in another location.
 961 If none of these files exist, and the C<-profile> option is not given
 962 to the constructor, then all Policies will be loaded with their
 963 default configuration.
 964
 965 The format of the configuration file is a series of INI-style
 966 blocks that contain key-value pairs separated by '='. Comments
 967 should start with '#' and can be placed on a separate line or after
 968 the name-value pairs if you desire.
 969
 970 Default settings for Perl::Critic itself can be set B<before the first
 971 named block.>  For example, putting any or all of these at the top of
 972 your configuration file will set the default value for the
 973 corresponding Perl::Critic constructor argument.
 974
 975     severity  = 3                                     #Integer from 1 to 5
 976     only      = 1                                     #Zero or One
 977     force     = 0                                     #Zero or One
 978     verbose   = 4                                     #Integer or format spec
 979     top       = 50                                    #A positive integer
 980     theme     = risky + (pbp * security) - cosmetic   #A theme expression
 981     include   = NamingConventions ClassHierarchies    #Space-delimited list
 982     exclude   = Variables  Modules::RequirePackage    #Space-delimited list
 983     color     = 1                                     #Zero or One
 984
 985 The remainder of the configuration file is a series of blocks like
 986 this:
 987
 988     [Perl::Critic::Policy::Category::PolicyName]
 989     severity = 1
 990     set_themes = foo bar
 991     add_themes = baz
 992     arg1 = value1
 993     arg2 = value2
 994
 995 C<Perl::Critic::Policy::Category::PolicyName> is the full name of a
 996 module that implements the policy.  The Policy modules distributed
 997 with Perl::Critic have been grouped into categories according to the
 998 table of contents in Damian Conway's book B<Perl Best Practices>. For
 999 brevity, you can omit the C<'Perl::Critic::Policy'> part of the
1000 module name.
1001
1002 C<severity> is the level of importance you wish to assign to the
1003 Policy.  All Policy modules are defined with a default severity value
1004 ranging from 1 (least severe) to 5 (most severe).  However, you may
1005 disagree with the default severity and choose to give it a higher or
1006 lower severity, based on your own coding philosophy.
1007
1008 The remaining key-value pairs are configuration parameters that will
1009 be passed into the constructor of that Policy.  The constructors for
1010 most Policy modules do not support arguments, and those that do should
1011 have reasonable defaults.  See the documentation on the appropriate
1012 Policy module for more details.
1013
1014 Instead of redefining the severity for a given Policy, you can
1015 completely disable a Policy by prepending a '-' to the name of the
1016 module in your configuration file.  In this manner, the Policy will
1017 never be loaded, regardless of the C<-severity> given to the
1018 Perl::Critic::Config constructor.
1019
1020 A simple configuration might look like this:
1021
1022     #--------------------------------------------------------------
1023     # I think these are really important, so always load them
1024
1025     [TestingAndDebugging::RequireUseStrict]
1026     severity = 5
1027
1028     [TestingAndDebugging::RequireUseWarnings]
1029     severity = 5
1030
1031     #--------------------------------------------------------------
1032     # I think these are less important, so only load when asked
1033
1034     [Variables::ProhibitPackageVars]
1035     severity = 2
1036
1037     [ControlStructures::ProhibitPostfixControls]
1038     allow = if unless  #My custom configuration
1039     severity = 2
1040
1041     #--------------------------------------------------------------
1042     # Give these policies a custom theme.  I can activate just
1043     # these policies by saying (-theme => 'larry + curly')
1044
1045     [Modules::RequireFilenameMatchesPackage]
1046     add_themes = larry
1047
1048     [TestingAndDebugging::RequireTestLables]
1049     add_themes = curly moe
1050
1051     #--------------------------------------------------------------
1052     # I do not agree with these at all, so never load them
1053
1054     [-NamingConventions::ProhibitMixedCaseVars]
1055     [-NamingConventions::ProhibitMixedCaseSubs]
1056
1057     #--------------------------------------------------------------
1058     # For all other Policies, I accept the default severity, theme
1059     # and other parameters, so no additional configuration is
1060     # required for them.
1061
1062 For additional configuration examples, see the F<perlcriticrc> file
1063 that is included in this F<t/examples> directory of this distribution.
1064
1065 =head1 THE POLICIES
1066
1067 A large number of Policy modules are distributed with Perl::Critic.
1068 They are described briefly in the companion document
1069 L<Perl::Critic::PolicySummary> and in more detail in the individual
1070 modules themselves.
1071
1072 =head1 POLICY THEMES
1073
1074 Each Policy is defined with one or more "themes".  Themes can be used to
1075 create arbitrary groups of Policies.  They are intended to provide an
1076 alternative mechanism for selecting your preferred set of Policies.  For
1077 example, you may wish disable a certain subset of Policies when analyzing test
1078 scripts.  Conversely, you may wish to enable only a specific subset of
1079 Policies when analyzing modules.
1080
1081 The Policies that ship with Perl::Critic are have been broken into the
1082 following themes.  This is just our attempt to provide some basic logical
1083 groupings.  You are free to invent new themes that suit your needs.
1084
1085     THEME             DESCRIPTION
1086     --------------------------------------------------------------------------
1087     core              All policies that ship with Perl::Critic
1088     pbp               Policies that come directly from "Perl Best Practices"
1089     bugs              Policies that that prevent or reveal bugs
1090     maintenance       Policies that affect the long-term health of the code
1091     cosmetic          Policies that only have a superficial effect
1092     complexity        Policies that specificaly relate to code complexity
1093     security          Policies that relate to security issues
1094     tests             Policies that are specific to test scripts
1095
1096
1097 Say C<`perlcritic -list`> to get a listing of all available policies
1098 and the themes that are associated with each one.  You can also change
1099 the theme for any Policy in your F<.perlcriticrc> file.  See the
1100 L<"CONFIGURATION"> section for more information about that.
1101
1102 Using the C<-theme> option, you can combine theme names with mathematical and
1103 boolean operators to create an arbitrarily complex expression that represents
1104 a custom "set" of Policies.  The following operators are supported
1105
1106    Operator       Alternative         Meaning
1107    ----------------------------------------------------------------------------
1108    *              and                 Intersection
1109    -              not                 Difference
1110    +              or                  Union
1111
1112 Operator precedence is the same as that of normal mathematics.  You
1113 can also use parenthesis to enforce precedence.  Here are some examples:
1114
1115    Expression                  Meaning
1116    ----------------------------------------------------------------------------
1117    pbp * bugs                  All policies that are "pbp" AND "bugs"
1118    pbp and bugs                Ditto
1119
1120    bugs + cosmetic             All policies that are "bugs" OR "cosmetic"
1121    bugs or cosmetic            Ditto
1122
1123    pbp - cosmetic              All policies that are "pbp" BUT NOT "cosmetic"
1124    pbp not cosmetic            Ditto
1125
1126    -maintenance                All policies that are NOT "maintenance"
1127    not maintenance             Ditto
1128
1129    (pbp - bugs) * complexity     All policies that are "pbp" BUT NOT "bugs",
1130                                     AND "complexity"
1131    (pbp not bugs) and complexity  Ditto
1132
1133 Theme names are case-insensitive.  If C<-theme> is set to an empty string,
1134 then it is equivalent to the set of all Policies.  A theme name that doesn't
1135 exist is equivalent to an empty set.  Please See
1136 L<http://en.wikipedia.org/wiki/Set> for a discussion on set theory.
1137
1138 =head1 SEE ALSO
1139
1140 L<Perl::Critic::OptionsProcessor>, L<Perl::Critic::UserProfile>
1141
1142
1143 =head1 AUTHOR
1144
1145 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
1146
1147 =head1 COPYRIGHT
1148
1149 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
1150
1151 This program is free software; you can redistribute it and/or modify
1152 it under the same terms as Perl itself.  The full text of this license
1153 can be found in the LICENSE file included with this module.
1154
1155 =cut
1156
1157 ##############################################################################
1158 # Local Variables:
1159 #   mode: cperl
1160 #   cperl-indent-level: 4
1161 #   fill-column: 78
1162 #   indent-tabs-mode: nil
1163 #   c-indentation-style: bsd
1164 # End:
1165 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :