Created
January 16, 2012 16:35
-
-
Save njlg/1621673 to your computer and use it in GitHub Desktop.
Run Perl::Critic on entire project, convert results to Checkstyle format
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/bin/env perl | |
# | |
# Output Checkstyle XML from Perl::Critic | |
# | |
use strict; | |
use warnings; | |
use File::Find::Rule; | |
use Perl::Critic; | |
use Data::Dumper; | |
# set default Critic parameters | |
my $critic = Perl::Critic->new( -serverity => 'brutal', -theme => 'core' ); | |
# set checkstyle style format | |
Perl::Critic::Violation::set_format("<error line='%l' column='%c' severity='%s' source='PerlCritic.%p' message='[%p] %m' />\n"); | |
my $file = shift; | |
my @files; | |
if ($file) { | |
@files = ($file); | |
} | |
else { | |
my $rule = File::Find::Rule->file()->name( '*.pm', '*.cgi', '*.pl' )->start(q{.}); | |
while ( $file = $rule->match ) { | |
push @files, $file; | |
} | |
} | |
#print Dumper(\@files); | |
my $severity = { | |
'1' => 'error', | |
'2' => 'error', | |
'3' => 'error', | |
'4' => 'warning', | |
'5' => 'info', | |
}; | |
print q{<?xml version="1.0" encoding="UTF-8"?>} . "\n"; | |
print q{<checkstyle version="1.0.0">} . "\n"; | |
for my $file (@files) { | |
my @violations = $critic->critique($file); | |
if ( $#violations > 1 ) { | |
print qq{<file name="$file">\n}; | |
foreach (@violations) { | |
# try and fix single quotes | |
$_ =~ /message='(.+)'/sxm; | |
if ($1) { | |
my $message = $1; | |
# $message =~ s/(['"])/\\$1/g; | |
$message =~ s/&/&/gsxm; | |
$message =~ s/'/'/gsxm; | |
$message =~ s/</</gsxm; | |
$message =~ s/>/>/gsxm; | |
$_ =~ s/message='.+'/message='$message'/gsxm; | |
} | |
# convert severity | |
$_ =~ /severity='([1-5])'/sxm; | |
if ( $1 && $severity->{$1} ) { | |
my $line_severity = $severity->{$1}; | |
$_ =~ s/severity='.'/severity='$line_severity'/gsxm; | |
} | |
# convert Package name to source name for checkstyle | |
$_ =~ /source='([^']+)'/sxm; | |
if ($1) { | |
my $source = $1; | |
$source =~ s/::/./gsxm; | |
$_ =~ s/source='[^']+'/source='$source'/gsxm; | |
} | |
print $_; | |
} | |
print q{</file>} . "\n"; | |
} | |
} | |
print q{</checkstyle>} . "\n"; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Little fix I had to use: