07/06/14 15:51:21
use strict;
my @A = qw(a to t toa);
@A = sort comp @A;
print "@A";
sub comp {
my($p, $x, $y);
do {
$x = substr $a, $p, 1;
$y = substr $b, $p, 1;
return $y cmp '' if $x eq '';
return '' cmp $x if $y eq '';
} while($p++, $x eq $y);
return $x cmp $y;
}