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

   1 ##############################################################################
   2 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/PolicyConfig.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::PolicyConfig;
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use Readonly;
  15
  16 our $VERSION = '1.088';
  17
  18 use Perl::Critic::Exception::AggregateConfiguration;
  19 use Perl::Critic::Exception::Configuration::Option::Policy::ParameterValue;
  20 use Perl::Critic::Utils qw< :booleans :characters severity_to_number >;
  21
  22 #-----------------------------------------------------------------------------
  23
  24 Readonly::Scalar my $NON_PUBLIC_DATA    => '_non_public_data';
  25 Readonly::Scalar my $NO_LIMIT           => 'no_limit';
  26
  27 #-----------------------------------------------------------------------------
  28
  29 sub new {
  30     my ($class, $policy_short_name, $specification) = @_;
  31
  32     my %self = $specification ? %{ $specification } : ();
  33     my %non_public_data;
  34
  35     $non_public_data{_policy_short_name} = $policy_short_name;
  36
  37     foreach my $standard_parameter (
  38         qw< maximum_violations_per_document severity set_themes add_themes >
  39     ) {
  40         if ( exists $self{$standard_parameter} ) {
  41             $non_public_data{"_$standard_parameter"} =
  42                 delete $self{$standard_parameter};
  43         }
  44     }
  45
  46     $self{$NON_PUBLIC_DATA} = \%non_public_data;
  47
  48
  49     return bless \%self, $class;
  50 }
  51
  52 #-----------------------------------------------------------------------------
  53
  54 sub _validate_maximum_violations_per_document {
  55     my ($self, $errors) = @_;
  56
  57     my $user_maximum_violations =
  58         $self->get_maximum_violations_per_document();
  59
  60     if ( defined $user_maximum_violations ) {
  61         if (
  62                 $user_maximum_violations =~ m/$NO_LIMIT/xmsio
  63             or  $user_maximum_violations eq $EMPTY
  64         ) {
  65             $user_maximum_violations = undef;
  66         }
  67         elsif ( not is_integer($user_maximum_violations) ) {
  68             $errors->add_exception(
  69                 new_parameter_value_exception(
  70                     'maximum_violations_per_document',
  71                     $user_maximum_violations,
  72                     undef,
  73                     "does not look like an integer.\n"
  74                 )
  75             );
  76
  77             return;
  78         }
  79         elsif ( $user_maximum_violations < 0 ) {
  80             $errors->add_exception(
  81                 new_parameter_value_exception(
  82                     'maximum_violations_per_document',
  83                     $user_maximum_violations,
  84                     undef,
  85                     "is not greater than or equal to zero.\n"
  86                 )
  87             );
  88
  89             return;
  90         }
  91
  92         $self->set_maximum_violations_per_document(
  93             $user_maximum_violations
  94         );
  95     }
  96
  97     return;
  98 }
  99
 100 #-----------------------------------------------------------------------------
 101
 102 sub _get_non_public_data {
 103     my $self = shift;
 104
 105     return $self->{$NON_PUBLIC_DATA};
 106 }
 107
 108 #-----------------------------------------------------------------------------
 109
 110 sub get_policy_short_name {
 111     my $self = shift;
 112
 113     return $self->_get_non_public_data()->{_policy_short_name};
 114 }
 115
 116 #-----------------------------------------------------------------------------
 117
 118 sub get_set_themes {
 119     my ($self) = @_;
 120
 121     return $self->_get_non_public_data()->{_set_themes};
 122 }
 123
 124 #-----------------------------------------------------------------------------
 125
 126 sub get_add_themes {
 127     my ($self) = @_;
 128
 129     return $self->_get_non_public_data()->{_add_themes};
 130 }
 131
 132 #-----------------------------------------------------------------------------
 133
 134 sub get_severity {
 135     my ($self) = @_;
 136
 137     return $self->_get_non_public_data()->{_severity};
 138 }
 139
 140 #-----------------------------------------------------------------------------
 141
 142 sub is_maximum_violations_per_document_unlimited {
 143     my ($self) = @_;
 144
 145     my $maximum_violations = $self->get_maximum_violations_per_document();
 146     if (
 147             not defined $maximum_violations
 148         or  $maximum_violations eq $EMPTY
 149         or  $maximum_violations =~ m<\A $NO_LIMIT \z>xmsio
 150     ) {
 151         return $TRUE;
 152     }
 153
 154     return $FALSE;
 155 }
 156
 157 #-----------------------------------------------------------------------------
 158
 159 sub get_maximum_violations_per_document {
 160     my ($self) = @_;
 161
 162     return $self->_get_non_public_data()->{_maximum_violations_per_document};
 163 }
 164
 165 #-----------------------------------------------------------------------------
 166
 167 sub get {
 168     my ($self, $parameter) = @_;
 169
 170     return if $parameter eq $NON_PUBLIC_DATA;
 171
 172     return $self->{$parameter};
 173 }
 174
 175 #-----------------------------------------------------------------------------
 176
 177 sub remove {
 178     my ($self, $parameter) = @_;
 179
 180     return if $parameter eq $NON_PUBLIC_DATA;
 181
 182     delete $self->{$parameter};
 183
 184     return;
 185 }
 186
 187 #-----------------------------------------------------------------------------
 188
 189 sub is_empty {
 190     my ($self) = @_;
 191
 192     return 1 >= keys %{$self};
 193 }
 194
 195 #-----------------------------------------------------------------------------
 196
 197 sub get_parameter_names {
 198     my ($self) = @_;
 199
 200     return grep { $_ ne $NON_PUBLIC_DATA } keys %{$self};
 201 }
 202
 203 #-----------------------------------------------------------------------------
 204
 205 1;
 206
 207 __END__
 208
 209 #-----------------------------------------------------------------------------
 210
 211 =pod
 212
 213 =for stopwords
 214
 215 =head1 NAME
 216
 217 Perl::Critic::PolicyConfig - Configuration data for a Policy.
 218
 219
 220 =head1 DESCRIPTION
 221
 222 A container for the configuration of a Policy.
 223
 224
 225 =head1 METHODS
 226
 227 =over
 228
 229 =item C<get_policy_short_name()>
 230
 231 The name of the policy this configuration is for.  Primarily here for
 232 the sake of debugging.
 233
 234
 235 =item C< get_set_themes() >
 236
 237 The value of C<set_themes> in the user's F<.perlcriticrc>.
 238
 239
 240 =item C< get_add_themes() >
 241
 242 The value of C<add_themes> in the user's F<.perlcriticrc>.
 243
 244
 245 =item C< get_severity() >
 246
 247 The value of C<severity> in the user's F<.perlcriticrc>.
 248
 249
 250 =item C< is_maximum_violations_per_document_unlimited() >
 251
 252 Answer whether the value of C<maximum_violations_per_document> should
 253 be considered to be unlimited.
 254
 255
 256 =item C< get_maximum_violations_per_document() >
 257
 258 The value of C<maximum_violations_per_document> in the user's
 259 F<.perlcriticrc>.
 260
 261
 262 =item C< get($parameter) >
 263
 264 Retrieve the value of the specified parameter in the user's
 265 F<.perlcriticrc>.
 266
 267
 268 =item C< remove($parameter) >
 269
 270 Delete the value of the specified parameter.
 271
 272
 273 =item C< is_empty() >
 274
 275 Answer whether there is any non-standard configuration information
 276 left.
 277
 278
 279 =item C< get_parameter_names() >
 280
 281 Retrieve the names of the parameters in this object.
 282
 283
 284 =back
 285
 286
 287 =head1 SEE ALSO
 288
 289 L<Perl::Critic::DEVELOPER/"MAKING YOUR POLICY CONFIGURABLE">
 290
 291
 292 =head1 AUTHOR
 293
 294 Elliot Shank <perl@galumph.com>
 295
 296
 297 =head1 COPYRIGHT
 298
 299 Copyright (c) 2008 Elliot Shank.  All rights reserved.
 300
 301 This program is free software; you can redistribute it and/or modify
 302 it under the same terms as Perl itself.  The full text of this license
 303 can be found in the LICENSE file included with this module.
 304
 305 =cut
 306
 307 # Local Variables:
 308 #   mode: cperl
 309 #   cperl-indent-level: 4
 310 #   fill-column: 78
 311 #   indent-tabs-mode: nil
 312 #   c-indentation-style: bsd
 313 # End:
 314 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :