| Subject: | bugs |
| Date: | Sat, 04 Nov 2006 11:11:40 +0600 |
| To: | bug-Perl-Critic [...] rt.cpan.org. |
| From: | "Lars K.W. Gohlke" <lars.gohlke [...] student.sgu.ac.id> |
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
hallo
Dist : Perl-Critic-0.2
PerlVer : This is perl, v5.8.8 built for i586-linux-thread-multi
BUG : false positive
* Expression form of "eval" ( occurrences:1, policy :
BuiltinFunctions::ProhibitStringyEval)
explanation:
The string form of `eval' is recompiled every time it is executed,
whereas the block form is only compiled once. Also, the string form
doesn't give compile-time warnings.
eval "print $foo"; #not ok
eval {print $foo}; #ok
[file:_test_sig-code.pl,line:14,col:3]
code: eval ( '$SIG{'.$_.'} = sub {print ("das war '.$_.'!\n");}' );
P.S. attached usefull script
- ------------------------
Mit freundlichen Grüßen
Lars K.W. Gohlke
mailto:lkwg82@gmx.de
- -------------------------
Visit http://www.lars-gohlke.de.vu
03.11.2006 19:32 (MESZ+5,MEZ+6)
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.3 (MingW32) - GPGrelay v0.959
iD8DBQFFTCEOAAomYJ1taN8RApa4AJ9m55URoBr0RQLwwHrttSWDyksd9ACdFb07
t3/IG1lR6b2GotXQAFCQQoI=
=LSTS
-----END PGP SIGNATURE-----
#!perl
use strict;
use warnings;
use Data::Dumper;
use File::Find;
use Perl::Critic;
use Perl::Critic::Utils;
use Term::ANSIColor qw(:constants);
$Term::ANSIColor::AUTORESET = 1;
our $serverity = 5;
my $statistics = {};
# caching results for a small performance boost
use File::Spec;
my $cache_path = File::Spec->catdir(File::Spec->tmpdir,
"test-perl-critic-cache-$ENV{USER}");
if (!-d $cache_path) {
mkdir $cache_path, oct 700;
}
require PPI::Cache;
PPI::Cache->import(path => $cache_path);
# /end caching
if (scalar(@ARGV) == 1){
&checkCritic($ARGV[0])
}
else{
find(\&check,'.');
}
print "-"x50,"\n";
print "* stats *\n";
print "-"x50,"\n";
grep{
if ( $_ eq 'violation'){
my $key = $_;
print "* voilations sorted desc \n";
grep{
print YELLOW sprintf("%5s%-50s","",$_);
print RED sprintf("%10d\n",$statistics->{$key}{$_});
}sort {$statistics->{$key}{$b} <=> $statistics->{$key}{$a}}(keys %{$statistics->{$key}});
print "*\n";
}
else{
print YELLOW sprintf("%-55s",$_);
print RED sprintf("%10d\n",$statistics->{$_});
}
}sort (keys %{$statistics});
sub check{
( local $_ = $File::Find::name) =~ s/^\.\///;
# not touch .hidden files and not self
&checkCritic($_) if (!(/^\./) && (/\.pl/) && ($_ ne $0 ));
}
sub checkCritic{
my $file = shift;
my $delimiter = '_#§§#_';
my @format_string;
grep{ push(@format_string,"$_:\%$_"); }qw/m f l c e d r P p s/;
my $format_string = join( $delimiter,@format_string);
my $opts_ref = {
'-verbose' => $format_string,#"%m \\n LOC: %r \\n (file: %f, line: %l, column: %c, severity: %s; policy: %p) \\n Explanation: \\n %d \\n",
'-severity' => $serverity
};
my $critic = Perl::Critic->new( %$opts_ref );
my @violations = $critic->critique($file);
render_report( $file, $opts_ref, @violations );
my $viol_count = scalar(@violations);
$statistics->{'violations'} += $viol_count;
$statistics->{'checked files'}++;
if ( $viol_count>0 ){
print "="x80,"\n";
print BOLD YELLOW $file." ";
print "( ";
print RED $viol_count;
print " warnings, serverity: $serverity )\n";
}
my $space = length($viol_count);
my %viol;
grep{
my %data;
grep{
(my $multiline =$_ ) =~ s/^(.*?)\ *\://o;
$data{$1} = $multiline;
}split /$delimiter/, $_;
push( @{$viol{$data{'f'}}},\%data);
}@violations;
grep{
my $file = $_;
my @warnings = @{$viol{$file}};
# helping
my $i = 0;
my $old_msg = "";
my %_sorted_messages = ();
my %policies = ();
my %explanation = ();
grep{
push(@{$_sorted_messages{$_->{'m'}}},$_);
$policies{$_->{'m'}} = $_->{'p'};
$explanation{$_->{'m'}}= $_->{'d'};
}sort {$a->{'m'} cmp $b->{'m'} }@warnings;
#print Dumper( keys %_sorted_messages );
grep{
my $msg = $_;
my $isSame = ( $msg eq $old_msg );
my @data = @{$_sorted_messages{$msg}};
$statistics->{'violation'}{$msg} += scalar(@data);
print BOLD RED '* ';
print GREEN $msg;
print " ( occurrences:".scalar(@data).", policy : ".$policies{$msg}.")\n";
print BLUE " explanation: \n";
print YELLOW $explanation{$msg}."\n\n";
grep{
#print BLUE sprintf("%4d ", ++$i);
print RED "[";
print CYAN "file:";
print YELLOW $_->{'f'};
print ",";
print CYAN "line:";
print YELLOW $_->{'l'};
print ",";
print CYAN "col:";
print YELLOW $_->{'c'};
print RED "]\t";
print GREEN $_->{'r'};
print "\n";
# %m Brief description of the violation
# %f Name of the file where the violation occurred.
# %l Line number where the violation occurred
# %c Column number where the violation occurred
# %e Explanation of violation or page numbers in PBP
# %d Full diagnostic discussion of the violation
# %r The string of source code that caused the violation
# %P Name of the Policy module that created the violation
# %p Name of the Policy without the Perl::Critic::Policy:: prefix
# %s The severity level of the violation
#print BOLD YELLOW $data{'m'},"\n";
}sort {$a->{'l'} <=> $b->{'l'}}@data;
#
if ( !$isSame ){
print BLUE "-"x80,"\n"x2;
}
$old_msg = $msg;
}sort (keys %_sorted_messages);
}sort (keys %viol);
#print Dumper( $critic->config() );
print "\n";
}
# taken from perlcritic
#-----------------------------------------------------------------------------
sub render_report {
my ( $file, $opts_ref, @violations ) = @_;
if( !@violations && !$opts_ref->{-quiet} ) {
if ( ! ref $file ) {
print "$file ";
}
print "source OK";
return 0;
}
$file = -f $file ? $file : 'stdin';
my $fmt = _get_format( $opts_ref->{-verbose} || 5 );
$fmt =~ s{ \%f }{$file}mxg; #HACK! Violation objects don't know the file
Perl::Critic::Violation::set_format( $fmt );
#print @violations;
return \@violations;
}
#-----------------------------------------------------------------------------
sub _get_format {
my ( $verbosity ) = @_;
my $is_integer = $verbosity =~ m{ \A [+-]? \d+ \z }mx;
return $is_integer ? verbosity_to_format($verbosity)
: _interpolate($verbosity);
}
#-----------------------------------------------------------------------------
sub _interpolate {
my ( $literal ) = @_;
return eval "\"$literal\""; ## no critic 'StringyEval';
}
Message body is not shown because sender requested not to inline it.