Login
Add -color-severity-5, -colour-severity-5, and so on as aliases for -color-severity...
authorTom Wyant <harryfmudd@comcast.net>
Sun, 25 Jan 2009 03:04:37 +0000 (03:04 +0000)
committerTom Wyant <harryfmudd@comcast.net>
Sun, 25 Jan 2009 03:04:37 +0000 (03:04 +0000)
bin/perlcritic
lib/Perl/Critic/Config.pm
lib/Perl/Critic/OptionsProcessor.pm
lib/Perl/Critic/Utils/DataConversion.pm
t/04_options_processor.t
t/07_perlcritic.t

index f721b5b..eb938b5 100755 (executable)
@@ -453,11 +453,11 @@ sub _get_option_specification {
         theme=s
         top:i
         verbose=s
-        color-severity-highest|colour-severity-highest=s
-        color-severity-high|colour-severity-high=s
-        color-severity-medium|colour-severity-medium=s
-        color-severity-low|colour-severity-low=s
-        color-severity-lowest|colour-severity-lowest=s
+        color-severity-highest|colour-severity-highest|color-severity-5|colour-severity-5=s
+        color-severity-high|colour-severity-high|color-severity-4|colour-severity-4=s
+        color-severity-medium|colour-severity-medium|color-severity-3|colour-severity-3=s
+        color-severity-low|colour-severity-low|color-severity-2|colour-severity-2=s
+        color-severity-lowest|colour-severity-lowest|color-severity-1|colour-severity-1=s
     );
 }
 
@@ -611,6 +611,11 @@ C<perlcritic> - Command-line interface to critique Perl source.
              [--force | --noforce] [--statistics] [--statistics-only]
              [--count | -C] [--verbose {number | format}]
              [--color | --nocolor] [--pager pager] [--quiet]
+             [--color-severity-highest color_specification]
+             [--color-severity-high color_specification]
+             [--color-severity-medium color_specification]
+             [--color-severity-low color_specification]
+             [--color-severity-lowest color_specification]
              {FILE | DIRECTORY | STDIN}
 
   perlcritic --profile-proto
@@ -974,6 +979,41 @@ Setting a pager turns off color by default.  You will have to turn color on
 explicitly.  If you want color, you'll probably also want to tell your pager
 to display raw characters.  For C<less> and C<more>, use the -R switch.
 
+=item C<--color-severity-highest COLOR_SPECIFICATION>
+
+Specifies the color to be used for highest severity violations, as a
+Term::ANSIColor color specification. Can also be specified as
+C<--colour-severity-highest>, C<--color-severity-5>, or
+C<--colour-severity-5>.
+
+=item C<--color-severity-high COLOR_SPECIFICATION>
+
+Specifies the color to be used for high severity violations, as a
+Term::ANSIColor color specification. Can also be specified as
+C<--colour-severity-high>, C<--color-severity-4>, or
+C<--colour-severity-4>.
+
+=item C<--color-severity-medium COLOR_SPECIFICATION>
+
+Specifies the color to be used for medium severity violations, as a
+Term::ANSIColor color specification. Can also be specified as
+C<--colour-severity-medium>, C<--color-severity-3>, or
+C<--colour-severity-3>.
+
+=item C<--color-severity-low COLOR_SPECIFICATION>
+
+Specifies the color to be used for low severity violations, as a
+Term::ANSIColor color specification. Can also be specified as
+C<--colour-severity-low>, C<--color-severity-2>, or
+C<--colour-severity-2>.
+
+=item C<--color-severity-lowest COLOR_SPECIFICATION>
+
+Specifies the color to be used for lowest severity violations, as a
+Term::ANSIColor color specification. Can also be specified as
+C<--colour-severity-lowest>, C<--color-severity-1>, or
+C<--colour-severity-1>.
+
 =item C<--doc PATTERN>
 
 Displays the perldoc for all
index b3858ee..312644b 100644 (file)
@@ -1009,27 +1009,37 @@ the benefit of L<criticism|criticism>.
 B<-color-severity-highest> is a string representing the highest
 severity violation color, as expected by Term::ANSIColor. It is not
 used by Perl::Critic, but is provided for the benefit of
-L<perlcritic|perlcritic>.
+L<perlcritic|perlcritic>. It can also be specified as
+B<-colour-severity-highest>, B<-color-severity-5>, or
+B<-colour-severity-5>.
 
 B<-color-severity-high> is a string representing the high severity
 violation color, as expected by Term::ANSIColor. It is not used by
 Perl::Critic, but is provided for the benefit of
-L<perlcritic|perlcritic>.
+L<perlcritic|perlcritic>. It can also be specified as
+B<-colour-severity-high>, B<-color-severity-4>, or
+B<-colour-severity-4>.
 
 B<-color-severity-medium> is a string representing the medium
 severity violation color, as expected by Term::ANSIColor. It is not
 used by Perl::Critic, but is provided for the benefit of
-L<perlcritic|perlcritic>.
+L<perlcritic|perlcritic>. It can also be specified as
+B<-colour-severity-medium>, B<-color-severity-3>, or
+B<-colour-severity-3>.
 
 B<-color-severity-low> is a string representing the low severity
 violation color, as expected by Term::ANSIColor. It is not used by
 Perl::Critic, but is provided for the benefit of
-L<perlcritic|perlcritic>.
+L<perlcritic|perlcritic>. It can also be specified as
+B<-colour-severity-low>, B<-color-severity-2>, or
+B<-colour-severity-2>.
 
 B<-color-severity-lowest> is a string representing the lowest
 severity violation color, as expected by Term::ANSIColor. It is not
 used by Perl::Critic, but is provided for the benefit of
-L<perlcritic|perlcritic>.
+L<perlcritic|perlcritic>. It can also be specified as
+B<-colour-severity-lowest>, B<-color-severity-1>, or
+B<-colour-severity-1>.
 
 =back
 
index 0e4c003..fd2128c 100644 (file)
@@ -60,29 +60,44 @@ sub _init {
     $self->{_pager}           = dor(delete $args{pager},              $EMPTY);
     $self->{_color_severity_highest} = dor(
         delete $args{'color-severity-highest'},
-        dor( delete $args{'colour-severity-highest'},
-            $PROFILE_COLOR_SEVERITY_HIGHEST_DEFAULT ));
+        delete $args{'colour-severity-highest'},
+        delete $args{'color-severity-5'},
+        delete $args{'colour-severity-5'},
+        $PROFILE_COLOR_SEVERITY_HIGHEST_DEFAULT,
+    );
     $self->{_color_severity_high} = dor(
         delete $args{'color-severity-high'},
-        dor( delete $args{'colour-severity-high'},
-            $PROFILE_COLOR_SEVERITY_HIGH_DEFAULT ));
+        delete $args{'colour-severity-high'},
+        delete $args{'color-severity-4'},
+        delete $args{'colour-severity-4'},
+        $PROFILE_COLOR_SEVERITY_HIGH_DEFAULT,
+    );
     $self->{_color_severity_medium} = dor(
         delete $args{'color-severity-medium'},
-        dor( delete $args{'colour-severity-medium'},
-            $PROFILE_COLOR_SEVERITY_MEDIUM_DEFAULT ));
+        delete $args{'colour-severity-medium'},
+        delete $args{'color-severity-3'},
+        delete $args{'colour-severity-3'},
+        $PROFILE_COLOR_SEVERITY_MEDIUM_DEFAULT,
+    );
     $self->{_color_severity_low} = dor(
         delete $args{'color-severity-low'},
-        dor( delete $args{'colour-severity-low'},
-            $PROFILE_COLOR_SEVERITY_LOW_DEFAULT ));
+        delete $args{'colour-severity-low'},
+        delete $args{'color-severity-2'},
+        delete $args{'colour-severity-2'},
+        $PROFILE_COLOR_SEVERITY_LOW_DEFAULT,
+    );
     $self->{_color_severity_lowest} = dor(
         delete $args{'color-severity-lowest'},
-        dor( delete $args{'colour-severity-lowest'},
-            $PROFILE_COLOR_SEVERITY_LOWEST_DEFAULT ));
+        delete $args{'colour-severity-lowest'},
+        delete $args{'color-severity-1'},
+        delete $args{'colour-severity-1'},
+        $PROFILE_COLOR_SEVERITY_LOWEST_DEFAULT,
+    );
 
     # If we're using a pager or not outputing to a tty don't use colors.
     # Can't use IO::Interactive here because we /don't/ want to check STDIN.
     my $default_color = ($self->pager() or not -t *STDOUT) ? $FALSE : $TRUE; ## no critic (ProhibitInteractiveTest)
-    $self->{_color} = dor(delete $args{color}, dor(delete $args{colour}, $default_color));
+    $self->{_color} = dor(delete $args{color}, delete $args{colour}, $default_color);
 
     # If there's anything left, complain.
     _check_for_extra_options(%args);
index 3f1e8ac..29637bd 100644 (file)
@@ -35,7 +35,10 @@ sub boolean_to_number {  ## no critic (RequireArgUnpacking)
 #-----------------------------------------------------------------------------
 
 sub dor {  ## no critic (RequireArgUnpacking)
-    return defined $_[0] ? $_[0] : $_[1];
+    foreach (@_) {
+        defined $_ and return $_;
+    }
+    return;
 }
 
 #-----------------------------------------------------------------------------
@@ -77,6 +80,12 @@ Return 0 or 1 based upon the value of parameter in a boolean context.
 Return either the value or the default based upon whether the value is
 defined or not.
 
+=item C<dor_n( $value0, $value1, ... )>
+
+Returns the first defined value among its arguments. If none is defined,
+simply returns.
+
+
 
 =item C<defined_or_empty( $value )>
 
index bd60f05..29afa6d 100644 (file)
@@ -17,7 +17,7 @@ use Perl::Critic::OptionsProcessor;
 use Perl::Critic::Utils qw< :booleans >;
 use Perl::Critic::Utils::Constants qw< :color_severity >;
 
-use Test::More tests => 42;
+use Test::More tests => 52;
 
 #-----------------------------------------------------------------------------
 
@@ -130,6 +130,42 @@ our $VERSION = '1.095_001';
         'gray',             'user default colour-severity-low' );
     is( $processor->color_severity_lowest(),
         'scots tartan',     'user default colour-severity-lowest' );
+
+    $processor = Perl::Critic::OptionsProcessor->new(
+         'color-severity-5'    => 'chartreuse',
+         'color-severity-4'    => 'fuschia',
+         'color-severity-3'    => 'blue',
+         'color-severity-2'    => 'gray',
+         'color-severity-1'    => 'scots tartan',
+    );
+    is( $processor->color_severity_highest(),
+        'chartreuse',       'user default color-severity-5' );
+    is( $processor->color_severity_high(),
+        'fuschia',          'user default color-severity-4' );
+    is( $processor->color_severity_medium(),
+        'blue',             'user default color-severity-3' );
+    is( $processor->color_severity_low(),
+        'gray',             'user default color-severity-2' );
+    is( $processor->color_severity_lowest(),
+        'scots tartan',     'user default color-severity-1' );
+
+    $processor = Perl::Critic::OptionsProcessor->new(
+         'colour-severity-5'    => 'chartreuse',
+         'colour-severity-4'    => 'fuschia',
+         'colour-severity-3'    => 'blue',
+         'colour-severity-2'    => 'gray',
+         'colour-severity-1'    => 'scots tartan',
+    );
+    is( $processor->color_severity_highest(),
+        'chartreuse',       'user default colour-severity-5' );
+    is( $processor->color_severity_high(),
+        'fuschia',          'user default colour-severity-4' );
+    is( $processor->color_severity_medium(),
+        'blue',             'user default colour-severity-3' );
+    is( $processor->color_severity_low(),
+        'gray',             'user default colour-severity-2' );
+    is( $processor->color_severity_lowest(),
+        'scots tartan',     'user default colour-severity-1' );
 }
 
 #-----------------------------------------------------------------------------
index 5592bbb..b96823a 100644 (file)
@@ -18,7 +18,7 @@ use File::Spec;
 
 use Perl::Critic::Utils qw< :characters >;
 
-use Test::More tests => 37;
+use Test::More tests => 57;
 
 #-----------------------------------------------------------------------------
 
@@ -183,9 +183,52 @@ is( $options{-quiet}, 1, $message);
 #-----------------------------------------------------------------------------
 
 local @ARGV = qw(-pager foo);
+$message = "@ARGV";
 %options = eval { get_options() };
-is( $options{-pager}, 'foo',  "@ARGV" );
+is( $options{-pager}, 'foo', $message );
+
 
+#-----------------------------------------------------------------------------
+
+foreach my $severity ([qw{
+    -color-severity-highest
+    -colour-severity-highest
+    -color-severity-5
+    -colour-severity-5
+    }],
+    [qw{
+    -color-severity-high
+    -colour-severity-high
+    -color-severity-4
+    -colour-severity-4
+    }],
+    [qw{
+    -color-severity-medium
+    -colour-severity-medium
+    -color-severity-3
+    -colour-severity-3
+    }],
+    [qw{
+    -color-severity-low
+    -colour-severity-low
+    -color-severity-2
+    -colour-severity-2
+    }],
+    [qw{
+    -color-severity-lowest
+    -colour-severity-lowest
+    -color-severity-1
+    -colour-severity-1
+    }],
+) {
+    my $canonical = $severity->[0];
+    foreach my $opt (@{ $severity }) {
+        local @ARGV = ($opt => 'cyan');
+        $message = "@ARGV";
+        %options = eval { get_options() };
+        is( $options{$canonical}, 'cyan', $message );
+    }
+}
 
 #-----------------------------------------------------------------------------
 # Intercept pod2usage so we can test invalid options and special switches