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";
		}
	}
}