Ich habe vorher noch Text::Aspell installiert, damit es das Wörterbuch etc. von aspell verwendet.
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use PPI;
use Search::Tools::SpellCheck;
use File::Basename;
use File::Find::Rule;
use List::Util qw(first);
my $dir = $ARGV[0];
if ( !$dir || !-d $dir ) {
say "$0 ";
exit;
}
my @files = File::Find::Rule->file->in( $dir );
my $spellchecker = Search::Tools::SpellCheck->new(
max_suggest => 4,
lang => 'en_US',
);
FILE:
for my $file ( @files ) {
# skip hidden files
my $filename = basename( $file );
next FILE if $filename =~ m{ \A \. }xms;
# skip some files
next FILE if first{ $filename eq $_ }( qw/INSTALL INSTALL.SuSE INSTALL.RedHat README CHANGES/ );
# skip some files based on path
next FILE if $file =~ m{/scripts/}xms;
next FILE if $file =~ m{/Language/}xms;
# skip some file types (based on suffix)
next FILE if $file =~ m{ \.(?:gif|png|js) \z }xms;
# check for typos in comments
my $comments = extract_comments( $file );
if ( $comments ) {
$comments =~ s/note:/note/;
eval {
my $suggestions_for_comments = $spellchecker->suggest( $comments ) || [];
print_suggestions( $file, $suggestions_for_comments );
};
}
# skip if the file if it's not a perl file
next FILE if $file =~ m{ \.(?:pm|pl) \z }xms;
# check for typos in pod
my $pod = extract_pod( $file, {} );
if ( $pod ) {
$pod =~ s/note:/note/;
eval {
my $suggestions_for_pod = $spellchecker->suggest( $pod ) || [];
print_suggestions( $file, $suggestions_for_pod );
};
}
}
sub print_suggestions {
my ($file, $suggestions) = @_;
return if !@{ $suggestions };
say $file, ':';
for my $suggestion ( @{ $suggestions } ) {
next if ref $suggestion ne 'HASH';
next if first{ $suggestion->{word} eq $_ }(qw/agpl txt otrs ag www html/);
next if $suggestion->{word} =~ m{ \A (?:\d+|\d+-\d+(?:-\d+)?) \z }xms;
say $suggestion->{word}, ' -> ', join ' __ ', @{$suggestion->{suggestions}}
if $suggestion->{suggestions} &&; @{ $suggestion->{suggestions} };
}
}
sub extract_comments {
my ($file) = @_;
return if !$file || !-f $file;
my $content = '';
if ( open my $fh, '<', $file ) {
while ( my $line = <$fh> ) {
my ($comment) = $line =~ m{ [#](.*) }xms;
next if !$comment;
$content .= ' ' . $comment;
}
}
return $content;
}
sub extract_pod {
my ($file, $config) = @_;
return if !$file || ! -f $file;
my $content;
if ( open my $fh, '<', $file ) {
if ( $config->{encoding} ) {
binmode $fh, ':encoding(' . $config->{encoding} . ')';
}
local $/;
$content = <$fh>;
}
my $pod = extract_pod_from_code( $content );
return $pod;
}
sub extract_pod_from_code {
my ($code) = @_;
return if !$code;
my $parser = PPI::Document->new( \$code );
return if !$parser;
my $pod_nodes = $parser->find(
sub {
$_[1]->isa( 'PPI::Token::Pod' );
},
);
my $merged = PPI::Token::Pod->merge( @{$pod_nodes || []} );
return '' if !$merged;
return $merged->content;
}
Einige Dateien musste ich rausnehmen, weil Search::Tools::SpellCheck ziemlich schnell Fehler wirft. Das ist auch der Grund, warum ich dann "eval" benutzt habe...
Wer noch Ideen hat, wie man das ganze verbessern kann, dann immer her damit. Das Prozedere hat noch einige Schwächen, weil auch Sachen wie "AG", "AGPL", "HTML" etc. agemeckert wird. Dadurch bekommt man ziemlich viele "False Positives" und man muss bei einem Projekt wie OTRS einige zehntausend Zeilen durchschauen um die wirklichen Fehler zu finden.
Es werden auch einige Fehler nicht gefunden...
2 comments:
Hi Renée,
kann es sein, dass hier Dinge verloren gegangen sind, z. B. beim usage-say-statement (fehlendes HTML-Escaping)?
LG, mg
Ja, der Editor von blogger.com ist nicht so toll...
Bei dem say-Statement wird das "< dir >" nicht angezeigt...
Und etwas weiter steht "&&;" statt "&&". Da habe ich wohl nicht alle Fehler gefixt.
Danke für den Hinweis!
Post a Comment