#!/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
	     $dir $path
	    );
use subs qw (
	     init_commandline usage
	    );
sub check_file($);

init_commandline;

# -- 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>) {
  chomp;
  print "Input-Line: $_\n" if ($debug);
  my ($correct, $false_s) = split (/\s*=\s*/, $_, 2);
  foreach my $false (split (/\s*,\s*/, $false_s)) {
    print "Fix: \"$false\" -> \"correct\"\n" if ($debug);
    $spell{$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  = ();

  my $result = GetOptions(
			  'help!'         => \$helpopt,
			  'spell-file=s'  => \$spell_file,
			  'file=s'        => \@input_files,
			  'dir=s'         => \@input_dirs,
			  '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!)
    --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;

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

  # Correct spelling. Yes this is only a single substitution. :-)
  if ($content =~ s/\b($spell_re)/$spell{$1}/eg) {
    print "False spellings found. File: \"$file\"\n" if ($debug);
    # And write back the file.
    open (FO, ">$file.tmp") or die ("Can't open file \".tmp$file\" 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);
  }
}