use warnings; use 5.014; # mostly for /r my %words = map {chomp; $_=>1} grep {!/'s$/} do { open my $fh, '<', '/usr/share/dict/words' or die $!; <$fh> }; my %search; for my $word (sort keys %words) { next unless $word=~ m{ \A (?
s )? (?[a-zA-Z0-9] ) (? (?: (?!\g{sep}) . )+ ) \g{sep} (?! \g{search} \g{sep} ) (? (?: (?!\g{sep}) . )* ) \g{sep} (? [msixpongr]* ) \z }msx; push @{ $search{$+{search}} }, { word=>$word, %+ }; } my @search = sort { length $b <=> length $a or $a cmp $b } keys %search; my ($re) = map {qr/$_/} join '|', map {quotemeta} @search; for my $word (sort keys %words) { next unless length $word > 1 && $word=~/($re)/; for my $s (@search) { next unless $word=~/\Q$s/; for my $r (@{$search{$s}}) { my $test = eval '$word=~s/\Q$s/$$r{repl}/r'.$$r{flags}; defined $test or die $@; next unless length $test > 1 && exists $words{$test} && $test ne $word; my ($pre,$pat) = ($$r{pre}//'s',$$r{word}); ( $pat = $$r{word} ) =~ s/\A\Q$$r{pre}// if $$r{pre}; my $code = "\$word =~$pre $pat$$r{flags}r"; eval($code) eq $test or die "$code - $test - $@"; say "$word =~$pre $pat => $test"; } } }