#!/ms/dist/perl5/bin/perl5.8

use strict;
use IPC::Open3;
use IO::Handle;

use MSDW::Version 'Time::HiRes' => '1.55';
use Time::HiRes 'time';

use constant DICT    => 'dict/Web2';
use constant TIMEOUT => 60 * 10;

use constant PERL    => './perl5.8';
use constant PYTHON  => './python2.4a';

use constant PROGDIR => 'programs';

BEGIN { do 'tests.pl'; }

my @programs = <@{[PROGDIR]}/*>;

report (GOODDIR, GOOD, \@programs);
report (BADDIR,  BAD,  \@programs);

###############################################################################

sub report {
  my ($dir, $tests, $programs) = @_;

  mkdir $dir;

  for my $test (@$tests) {
    my ($word1, $word2) = @$test;
    print "$word1 -> $word2\n";

    open (OUT, ">", "$dir/${word1}_$word2");

    for my $program (@$programs) {
      my ($ok, $steps, $time) = test ($program, $word1, $word2);

      my $name = $program;
      $name =~ s|^@{[PROGDIR]}/||;

      print OUT join ("|", $name, $ok, $steps, $time), "\n";
    }

    close OUT;
  }
}

sub test {
  my ($program, $word1, $word2) = @_;

  my $interpreter =
    ($program =~ /\.pl$/ ? PERL   :
     $program =~ /\.py$/ ? PYTHON : next);

  print "  $program\n";

  my $in  = IO::Handle->new;
  my $out = IO::Handle->new;
  my $err = IO::Handle->new;

  my $t1  = time;
  my $pid = open3 ($in, $out, $err,
                   $interpreter, $program, $word1, $word2, DICT);

  my $timedout = 0;
  local $SIG{ALRM} = sub { $timedout = 1; kill 9 => $pid; };
  alarm TIMEOUT;

  close $in;

  my @ladder = ();
  while (<$out>) {
    chomp;
    s/^\s*|\s*$//g;
    next if /^$/;

    push @ladder, $_;
  }

  my $err_output = 0;
  $err_output = 1 while (<$err>);

  waitpid $pid, 0;
  my $ret = $? >> 8;

  alarm 0;

  my $t2 = time;
  my $ok = ($ret == 0 and @ladder and !$timedout and !$err_output);

  $ok &&= ($ladder[0]  eq $word1);
  $ok &&= ($ladder[-1] eq $word2);

  if ($ok) {
    for my $idx (1..$#ladder) {
      $ok &&= (distance ($ladder[$idx], $ladder[$idx-1]) == 1);
      $ok || last;
    }
  }

  my $steps = ($ok ? scalar (@ladder) : '');
  my $time  = ($timedout ? '**' : $t2 - $t1);

  return ($ok, $steps, $time);
}

sub distance {
  my ($word1, $word2) = @_;

  my $tmp = lc ($word1) ^ lc ($word2);
  return ($tmp =~ tr/\0//c);
}