#! /usr/bin/perl -w

use strict;

my $startword=lc(shift @ARGV);
my $endword=lc(shift @ARGV);
unless ($endword) {
  die "You must specify a start and end word.\n";
}
my $len=length($startword);
if ($len ne length($endword)) {
  die "Start and end words must be the same length.\n";
}
my $dict=shift @ARGV || '/usr/share/dict/words';
unless (-e $dict) {
  die "Can't find dictionary file:\n$dict\n";
}
my %wordlist=($endword => 1);
open D,"<$dict";
while (<D>) {
  chomp;
  if (length($_) == $len) {
    $wordlist{lc($_)}=1;
  }
}
close D;

my @candidates=($startword);
my %wordinfo=($startword => []);

while (@candidates) {
  my $w=shift @candidates;
  if ($w ne $endword) {
    my @chain=@{$wordinfo{$w}};
    my $chain=1+scalar @chain;
    foreach my $pos (0..$len-1) {
      my $o=substr($w,$pos,1);
      foreach my $letter ('a'..'z') {
        if ($letter ne $o) {
          my $ww=$w;
          substr($ww,$pos,1)=$letter;
          if (exists $wordlist{$ww}) {
            my $new=1;
            if (exists $wordinfo{$ww}) {
              if ($chain >= scalar @{$wordinfo{$ww}}) {
                $new=0;
              }
            }
            if ($new) {
              $wordinfo{$ww}=[@chain,$w];
              push @candidates,$ww;
            }
          }
        }
      }
    }
  }
};

if (exists $wordinfo{$endword}) {
  print map{"$_\n"} (@{$wordinfo{$endword}},$endword);
} else {
  die "Unable to find a word ladder.\n";
}
