#!/usr/bin/perl -w use strict; use Getopt::Long; use vars qw ( $debug %spell $spell_re $spell_file @input_files $input_file @input_dirs $input_dir $onlycomments $do_fix $do_override $dir $path $fixed ); use subs qw ( init_commandline usage ); sub check_file($); sub check_content($$); init_commandline; # See if the spell-file is found in the current-dir # otherwise look in the dir from where we were started if (! -f $spell_file) { my $dir = $0; $dir =~ s/\/[^\/]+$/\//; if (-f "$dir/$spell_file") { $spell_file = "$dir/$spell_file"; } } # -- Read file with the spellings -- # File-Format # correct-word=false,false,false... open (FI, $spell_file) or die ("Can't open \"$spell_file\""); while () { s/\#.*$//; chomp; if ($_) { print "Input-Line: $_\n" if ($debug); my ($correct, $false_s) = split (/\s*=\s*/, $_, 2); $correct =~ s/^\s+//; $correct =~ s/\s+$//; foreach my $false (split (/\s*,\s*/, $false_s)) { $false =~ s/^\s+//; $false =~ s/\s+$//; if ($false ne $correct) { print "Fix: \"$false\" -> \"correct\"\n" if ($debug); $spell{$false} = $correct; } else { warn ("Error in Spell-file: \"$spell_file\" Line: $. \"$correct\" is the same for false & correct"); } } } } close (FI); # -- End -- # -- Create the regular expression -- my @temp_spell; foreach my $key (sort {$b cmp $a} keys %spell) { # For keys endig with a "\w"ord-charactar we add a "\b"oundary. # Otherwise we get into trouble with words that begin the same but are longer my $postfix = $key =~ /\w$/ ? '\b' : ''; push @temp_spell, "\Q$key\E$postfix" } $spell_re = join ("\|", @temp_spell); print "Spell_re: $spell_re\n" if ($debug); # -- End -- # Check files, if specified if ($#input_files >= 0) { foreach $input_file (@input_files) { print "Checking file: \"$input_file\"\n" if ($debug); check_file ($input_file); } } # Check dirs, if specified if ($#input_dirs >= 0) { foreach $input_dir (@input_dirs) { print "Checking dir: \"$input_dir\"\n" if ($debug); &traverse($input_dir); } } # When there was no file and/or dir argument(s) then process everything from current dir if ($#input_files == -1 && $#input_dirs == -1) { print "No dir/files specifed checking all files in the dir and subdirs\n" if ($debug); &traverse("."); } sub init_commandline { my $helpopt = 0; $debug = 0; $spell_file = "spell-fix.txt"; @input_files = (); @input_dirs = (); $onlycomments = 1; $do_override = 1; $do_fix = 1; my $result = GetOptions( 'help!' => \$helpopt, 'spell-file=s' => \$spell_file, 'file=s' => \@input_files, 'dir=s' => \@input_dirs, 'only-comments!' => \$onlycomments, 'fix!' => \$do_fix, 'override!' => \$do_override, 'debug!' => \$debug, ); usage() if $helpopt; } sub usage { print <<"EOF"; Usage: $0 , where valid options are --help # this message :-) --spell-file # File with the correction-list --file # File(s) to be checked --dir # Directory(s) to be checked (recursive!) --[no]only-comments # Only fix words inside a comment --[no]fix # Fix the errors? Or not? --[no]override # Override the original file or create a ".fixed"-file? --debug # Debugging-Messages EOF exit(0); } sub traverse { local($dir) = shift; local($path); unless (opendir(DIR, $dir)) { warn "Can't open $dir\n"; closedir(DIR); return; } foreach (readdir(DIR)) { next if $_ eq '.' || $_ eq '..'; $path = "$dir/$_"; if (-d $path) { # a directory &traverse($path); } elsif (-f _) { # a plain file check_file ($path); } } closedir(DIR); } sub check_file($) { my $file = shift; my $content; $fixed = 0; my $filenameprinted = 0; open (FI, $file) or return; $content = join ("", ); close (FI); if ($debug || !$do_fix) { while ($content =~ /\b($spell_re)/g) { if (!$filenameprinted) { print "File: \"$file\"\n"; $filenameprinted = 1; } print "False-Spelling: \"$1\" -> \"$spell{$1}\"\n"; } } # Correct spelling. Yes the "core" is only a single substitution. :-) if ($do_fix) { if ($onlycomments) { # Take I "//"-Comments $content =~ s!(//)(.+)$!check_content($1,$2)!egm; # Take II "/* ... */"-Comments $content =~ s!(/\*)(.+?)\*/!check_content($1,$2)!egs; } else { if ($content =~ s/\b($spell_re)/$spell{$1}/eg) { $fixed = 1; } } } if ($fixed) { my $filename = $do_override ? "$file.tmp" : "$file.fixed"; print "False spellings found. File: \"$file\"\n" if ($debug); # And write back the file. open (FO, ">$filename") or die ("Can't open file \"$filename\" for writing"); print FO $content; close (FO); if ($do_override) { rename ("$file", "$file.tmp2") or die ("Can't rename \"$file\" -> \"$file.tmp2\""); rename ("$file.tmp", "$file") or die ("Can't rename \"$file.tmp\" -> \"$file\""); unlink ("$file.tmp2") or die ("Can't unlink \"$file.tmp2\""); } } else { print "No false spellings found. File: \"$file\"\n" if ($debug); } } sub check_content($$) { my $comment = shift; my $content = shift; # print "Comment: $comment\n"; # print "content: $content\n"; if ($content =~ s/\b($spell_re)/$spell{$1}/eg) { $fixed = 1; } if ($comment eq "//") { return "//$content"; } else { return "/*$content*/"; } }