in reply to Scatterbrained

Very nice. I especially like the way pos() was used as an lvalue, and assigning a regexp match to the array slice @;[0,1]. Clever!

Here's my deconstruction, split apart, unusual variables replaced, and commented:

#!/usr/bin/perl -w use strict; my $source='Just another Perl hacker.'; # previously ($_{_}) my $reversed=''; # previously ($_{__}) my @split_source = $source =~ /./g; # previously (@_) $" = $/; # arrays assigned to strings are separated by newlines # only thing this does is add the final newline while(@split_source){ # for each character in the array $reversed .= pop @split_source; # concat it to the reversed strin +g } my @stages = ($reversed); my %E; # previously (%;) my @F; # previously (@;) my $G; # previously ($/) # while $G isn't eq source, find two random incorrect characters # and swap them, pushing the result onto @stages while(($G = $stages[-1]) ne $source) { @E{0..24} = map{pos $source = pos $G = $_; # start searching at $ +_ ($a) = $G =~/./g; # find characters at t +hat point ($b) = $source =~ /./g; # and compare them "$a" eq $b # expr same as substr( +$source,$_,1) eq substr($G,$_,1) } (0..24); # so $E{n} is true if +nth letter of G is correct @F = grep{!$E{$_}} keys(%E); # @F is list of incorr +ect character positions $a = $F[rand @F]; # pick random characte +r position from f do { $b = $F[rand @F] } while ($b == $a); # pick another random +character pos from f pos $G = $a; # start search pos for + $G at $a $| ||= 1; # set autoflush, this + need not be in the loop @F[0,1] = $G =~ /./g; # effect: $F[0] = subs +tr($G,$a,1) pos $G = $b; # start search pos for + $G at $b @F[1,2] = $G =~ /./g; # effect: $F[1] = subs +tr($G,$b,1) $G =~ s/(.{$a})./$1$F[1]/; # replaces a'th char o +f $G with $F[1] $G =~ s/(.{$b})./$1$F[0]/x; # replaces b'th char o +f $G with $F[0] @stages = (@stages => $G); # adds a new record to + @stages } # do the print out! for(@stages){ # for each stage s/^/\r/; # add a carriage return at the beginning print $_; # print it select undef,undef,undef,0.1; # wait .1 seconds } print" :-)"; sleep 1; print "@{['','']}"; # because $" set to $/, this just prints a newline
Update: Typo