or download this
#!/usr/local/bin/perl -w
use strict;
...
no strict;
while(w){($k,$v)=each%q;$k||redo;$u=$$v[a($k)];next if(g($u));while(($
+l,$x)=each%q){next unless$$x[0] eq $u;a($l)?$y=$$x[1]:goto N;goto E i
+f(g($y))}N:$b=i($u,$c=t);$q{$b}=[$u,$c];E:}