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

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/OptionsProcessor.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::OptionsProcessor;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use English qw(-no_match_vars);
  15
  16 use Perl::Critic::Exception::AggregateConfiguration;
  17 use Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter;
  18 use Perl::Critic::Utils qw<
  19     :booleans :characters :severities :data_conversion $DEFAULT_VERBOSITY
  20 >;
  21 use Perl::Critic::Utils::Constants qw< $PROFILE_STRICTNESS_DEFAULT >;
  22 use Perl::Critic::Utils::DataConversion qw< dor >;
  23
  24 our $VERSION = '1.088';
  25
  26 #-----------------------------------------------------------------------------
  27
  28 sub new {
  29     my ($class, %args) = @_;
  30     my $self = bless {}, $class;
  31     $self->_init( %args );
  32     return $self;
  33 }
  34
  35 #-----------------------------------------------------------------------------
  36
  37 sub _init {
  38     my ( $self, %args ) = @_;
  39
  40     # Multi-value defaults
  41     my $exclude = dor(delete $args{exclude}, $EMPTY);
  42     $self->{_exclude}    = [ words_from_string( $exclude ) ];
  43     my $include = dor(delete $args{include}, $EMPTY);
  44     $self->{_include}    = [ words_from_string( $include ) ];
  45
  46     # Single-value defaults
  47     $self->{_force}          = dor(delete $args{force},              $FALSE);
  48     $self->{_only}           = dor(delete $args{only},               $FALSE);
  49     $self->{_profile_strictness} =
  50         dor(delete $args{'profile-strictness'}, $PROFILE_STRICTNESS_DEFAULT);
  51     $self->{_single_policy}  = dor(delete $args{'single-policy'},    $EMPTY);
  52     $self->{_severity}       = dor(delete $args{severity},           $SEVERITY_HIGHEST);
  53     $self->{_theme}          = dor(delete $args{theme},              $EMPTY);
  54     $self->{_top}            = dor(delete $args{top},                $FALSE);
  55     $self->{_verbose}        = dor(delete $args{verbose},            $DEFAULT_VERBOSITY);
  56     $self->{_criticism_fatal} = dor(delete $args{'criticism-fatal'}, $FALSE);
  57
  58     $self->{_color} = dor(delete $args{color}, dor(delete $args{colour}, $TRUE));
  59
  60     # If there's anything left, complain.
  61     _check_for_extra_options(%args);
  62
  63     return $self;
  64 }
  65
  66 #-----------------------------------------------------------------------------
  67
  68 sub _check_for_extra_options {
  69     my %args = @_;
  70
  71     if ( my @remaining = sort keys %args ){
  72         my $errors = Perl::Critic::Exception::AggregateConfiguration->new();
  73
  74         foreach my $option_name (@remaining) {
  75             $errors->add_exception(
  76                 Perl::Critic::Exception::Configuration::Option::Global::ExtraParameter->new(
  77                     option_name     => $option_name,
  78                 )
  79             )
  80         }
  81
  82         $errors->rethrow();
  83     }
  84
  85     return;
  86 }
  87
  88 #-----------------------------------------------------------------------------
  89 # Public ACCESSOR methods
  90
  91 sub severity {
  92     my ($self) = @_;
  93     return $self->{_severity};
  94 }
  95
  96 #-----------------------------------------------------------------------------
  97
  98 sub theme {
  99     my ($self) = @_;
 100     return $self->{_theme};
 101 }
 102
 103 #-----------------------------------------------------------------------------
 104
 105 sub exclude {
 106     my ($self) = @_;
 107     return $self->{_exclude};
 108 }
 109
 110 #-----------------------------------------------------------------------------
 111
 112 sub include {
 113     my ($self) = @_;
 114     return $self->{_include};
 115 }
 116
 117 #-----------------------------------------------------------------------------
 118
 119 sub only {
 120     my ($self) = @_;
 121     return $self->{_only};
 122 }
 123
 124 #-----------------------------------------------------------------------------
 125
 126 sub profile_strictness {
 127     my ($self) = @_;
 128     return $self->{_profile_strictness};
 129 }
 130
 131 #-----------------------------------------------------------------------------
 132
 133 sub single_policy {
 134     my ($self) = @_;
 135     return $self->{_single_policy};
 136 }
 137
 138 #-----------------------------------------------------------------------------
 139
 140 sub verbose {
 141     my ($self) = @_;
 142     return $self->{_verbose};
 143 }
 144
 145 #-----------------------------------------------------------------------------
 146
 147 sub color {
 148     my ($self) = @_;
 149     return $self->{_color};
 150 }
 151
 152 #-----------------------------------------------------------------------------
 153
 154 sub criticism_fatal {
 155     my ($self) = @_;
 156     return $self->{_criticism_fatal};
 157 }
 158
 159 #-----------------------------------------------------------------------------
 160
 161 sub force {
 162     my ($self) = @_;
 163     return $self->{_force};
 164 }
 165
 166 #-----------------------------------------------------------------------------
 167
 168 sub top {
 169     my ($self) = @_;
 170     return $self->{_top};
 171 }
 172
 173
 174 1;
 175
 176 __END__
 177
 178 #-----------------------------------------------------------------------------
 179
 180 =pod
 181
 182 =head1 NAME
 183
 184 Perl::Critic::OptionsProcessor - The global configuration default values, combined with command-line values.
 185
 186 =head1 DESCRIPTION
 187
 188 This is a helper class that encapsulates the default parameters for
 189 constructing a L<Perl::Critic::Config> object.  There are no
 190 user-serviceable parts here.
 191
 192 =head1 CONSTRUCTOR
 193
 194 =over 8
 195
 196 =item C< new( %DEFAULT_PARAMS ) >
 197
 198 Returns a reference to a new C<Perl::Critic::OptionsProcessor> object.  You
 199 can override the coded defaults by passing in name-value pairs that
 200 correspond to the methods listed below.
 201
 202 This is usually only invoked by L<Perl::Critic::UserProfile>, which
 203 passes in the global values from a F<.perlcriticrc> file.  This object
 204 contains no information for individual Policies.
 205
 206 =back
 207
 208 =head1 METHODS
 209
 210 =over 8
 211
 212 =item C< exclude() >
 213
 214 Returns a reference to a list of the default exclusion patterns.  If
 215 there are no default exclusion patterns, then the list will be empty.
 216
 217 =item C< force() >
 218
 219 Returns the default value of the C<force> flag (Either 1 or 0).
 220
 221 =item C< include() >
 222
 223 Returns a reference to a list of the default inclusion patterns.  If
 224 there are no default exclusion patterns, then the list will be empty.
 225
 226 =item C< only() >
 227
 228 Returns the default value of the C<only> flag (Either 1 or 0).
 229
 230 =item C< profile_strictness() >
 231
 232 Returns the default value of C<profile_strictness> as an unvalidated
 233 string.
 234
 235 =item C< single_policy() >
 236
 237 Returns the default C<single-policy> pattern.  (As a string.)
 238
 239 =item C< severity() >
 240
 241 Returns the default C<severity> setting. (1..5).
 242
 243 =item C< theme() >
 244
 245 Returns the default C<theme> setting. (As a string).
 246
 247 =item C< top() >
 248
 249 Returns the default C<top> setting. (Either 0 or a positive integer).
 250
 251 =item C< verbose() >
 252
 253 Returns the default C<verbose> setting. (Either a number or format
 254 string).
 255
 256 =item C< color() >
 257
 258 Returns the default C<color> setting. (Either 1 or 0).
 259
 260 =item C< criticism_fatal() >
 261
 262 Returns the default C<criticism-fatal> setting (Either 1 or 0).
 263
 264 =back
 265
 266 =head1 SEE ALSO
 267
 268 L<Perl::Critic::Config>, L<Perl::Critic::UserProfile>
 269
 270 =head1 AUTHOR
 271
 272 Jeffrey Ryan Thalhammer <thaljef@cpan.org>
 273
 274 =head1 COPYRIGHT
 275
 276 Copyright (c) 2005-2008 Jeffrey Ryan Thalhammer.  All rights reserved.
 277
 278 This program is free software; you can redistribute it and/or modify
 279 it under the same terms as Perl itself.  The full text of this license
 280 can be found in the LICENSE file included with this module.
 281
 282 =cut
 283
 284 # Local Variables:
 285 #   mode: cperl
 286 #   cperl-indent-level: 4
 287 #   fill-column: 78
 288 #   indent-tabs-mode: nil
 289 #   c-indentation-style: bsd
 290 # End:
 291 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :