my (%hash, $line); while ($line = ) { while (my ($word) = (lc $word) =~ /[a-z]{2,}/g) { next if $word =~ /(.)\1\1\1\1/; $hash{$word}++; } } print "$_\n" for sort keys %hash;