#!/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
	     $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 (<FI>) {
  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;

  my $result = GetOptions(
			  'help!'          => \$helpopt,
			  'spell-file=s'   => \$spell_file,
			  'file=s'         => \@input_files,
			  'dir=s'          => \@input_dirs,
			  'only-comments!' => \$onlycomments,
			  'debug!'         => \$debug,
			 );

  usage() if $helpopt;
}

sub usage {
  print <<"EOF";
Usage: $0 <options>, where valid options are
    --help              # this message :-)
    --spell-file        # File with the correction-list
    --file <file>       # File(s) to be checked
    --dir <dir>         # Directory(s) to be checked (recursive!)
    --[no]only-comments # Only fix words inside a comment
    --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;

  open (FI, $file) or return;
  $content = join ("", <FI>);
  close (FI);

  if ($debug) {
    while ($content =~ /\b($spell_re)/g) {
      print "False-Spelling: \"$1\" -> \"$spell{$1}\"\n";
    }
  }

  # Correct spelling. Yes the "core" is only a single substitution. :-)
  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) {
    print "False spellings found. File: \"$file\"\n" if ($debug);
    # And write back the file.
    open (FO, ">$file.tmp") or die ("Can't open file \"$file.tmp\" for writing");
    print FO $content;
    close (FO);

    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*/";
  }
}