view release on metacpan or  search on metacpan

share/PerlCritic/Critic/Command.pm  view on Meta::CPAN

        only!
        options
        pager=s
        profile|p=s
        profile-proto
        quiet
        severity=i
        single-policy|s=s
        stern
        statistics!
        statistics-only!
        profile-strictness=s
        theme=s
        top:i
        allow-unsafe
        verbose=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
        files-with-violations|l
        files-without-violations|L
        program-extensions=s@
    >;
}

#-----------------------------------------------------------------------------

sub _colorize_by_severity {
    my @violations = @_;
    return @violations if _this_is_windows();
    return @violations if not eval {
        require Term::ANSIColor;
        Term::ANSIColor->VERSION( $_MODULE_VERSION_TERM_ANSICOLOR );
        1;
    };

    my $config = $critic->config();
    my %color_of = (
        $SEVERITY_HIGHEST   => $config->color_severity_highest(),
        $SEVERITY_HIGH      => $config->color_severity_high(),
        $SEVERITY_MEDIUM    => $config->color_severity_medium(),
        $SEVERITY_LOW       => $config->color_severity_low(),
        $SEVERITY_LOWEST    => $config->color_severity_lowest(),
    );

    return map { _colorize( "$_", $color_of{$_->severity()} ) } @violations;

}

#-----------------------------------------------------------------------------

sub _colorize {
    my ($string, $color) = @_;
    return $string if not defined $color;
    return $string if $color eq $EMPTY;
    # $terminator is a purely cosmetic change to make the color end at the end
    # of the line rather than right before the next line. It is here because
    # if you use background colors, some console windows display a little
    # fragment of colored background before the next uncolored (or
    # differently-colored) line.
    my $terminator = chomp $string ? "\n" : $EMPTY;
    return  Term::ANSIColor::colored( $string, $color ) . $terminator;
}

#-----------------------------------------------------------------------------

sub _this_is_windows {
    return 1 if $OSNAME =~ m/MSWin32/xms;
    return 0;
}

#-----------------------------------------------------------------------------

sub _at_tty {
    return -t STDOUT; ## no critic (ProhibitInteractiveTest);
}

#-----------------------------------------------------------------------------

sub _render_all_policy_listing {
    # Force P-C parameters, to catch all Policies on this site
    my %pc_params = (-profile => $EMPTY, -severity => $SEVERITY_LOWEST);
    return _render_policy_listing( %pc_params );
}

#-----------------------------------------------------------------------------

sub _render_policy_listing {
    my %pc_params = @_;

    require Perl::Critic::PolicyListing;
    require Perl::Critic;

    my @policies = Perl::Critic->new( %pc_params )->policies();
    my $listing = Perl::Critic::PolicyListing->new( -policies => \@policies );
    _out $listing;

    exit $EXIT_SUCCESS;
}

#-----------------------------------------------------------------------------

sub _render_theme_listing {

    require Perl::Critic::ThemeListing;
    require Perl::Critic;

    my %pc_params = (-profile => $EMPTY, -severity => $SEVERITY_LOWEST);
    my @policies = Perl::Critic->new( %pc_params )->policies();
    my $listing = Perl::Critic::ThemeListing->new( -policies => \@policies );
    _out $listing;

    exit $EXIT_SUCCESS;
}

#-----------------------------------------------------------------------------

sub _render_profile_prototype {