#!perl

use strict;
use warnings;

++$|;

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

my $wl_standard = 'englisch2.wl';

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

my ($wort_start,$wort_ziel,$wl) = @ARGV;
$wort_start = ($wort_start ne '') ? lc $wort_start : die 'Es muss ein Startwort übergeben werden!';
$wort_ziel  = ($wort_ziel ne '')  ? lc $wort_ziel  : die 'Es muss ein Zielwort übergeben werden!';
die 'Start und Zielwort müssen die selbe Länge haben!' if length $wort_start != length $wort_ziel;
$wl ||= $wl_standard;

print "
Startwort:   $wort_start
Zielwort:    $wort_ziel
Wörterliste: $wl

";

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

print "Wörterliste einlesen...";
open (DATEI,$wl) || die 'Wörterbuchdatei konnte nicht geöffnet werden!';
 chomp (my @w = <DATEI>);
close (DATEI);
my $l = length $wort_start;
my %w = map { lc($_) => 1 } grep { length $_ == $l } @w;
print " fertig\n";

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

die 'Das Startwort kommt im Wörterbuch nicht vor!' unless $w{$wort_start};
die 'Das Zielwort kommt im Wörterbuch nicht vor!'  unless $w{$wort_ziel};

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

my @zw = (([]) x length $wort_start);
$zw[0] = [$wort_start];

my %von;

print "Suche starten...";
while (1) {
 my $wort;
 foreach (0..$#zw) {
  next unless @{$zw[$_]};
  $wort = shift @{$zw[$_]};
  last;
 }
 unless ( defined $wort ) {
  print " fertig\n\n";
  print "Keine Lösung möglich!\n";
  exit;
 }
 foreach my $foo (&foo($wort)) {
  $von{$foo} = $wort;
  my $u = &bar($foo);
  if ( $u == 0 ) {
   print " fertig\n\n";
   my @weg = ($foo);
   while ( $foo ne $wort_start ) {
    $foo = $von{$foo};
    unshift @weg, $foo;
   }
   print (join(' -> ',@weg), "\n");
   exit;
  }
  push @{$zw[$u]}, $foo;
 }
}

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

sub foo {
 my $wort = shift;
 my @m;
 foreach my $i (0..length($wort)-1) {
  foreach my $v ('a'..'z') {
   next if substr($wort,$i,1) eq $v;
   my $m = substr($wort,0,$i).$v.substr($wort,$i+1);
   next unless $w{$m};
   next if $von{$m};
   push @m, $m;
  }
 }
 return @m;
}

sub bar {
 my $wort = shift;
 my $unterschied = length($wort);
 foreach my $i (0..length($wort)-1) {
  --$unterschied if substr($wort,$i,1) eq substr($wort_ziel,$i,1);
 }
 return $unterschied;
}