http://d.hatena.ne.jp/sugyan/20100826/1282759659

kakko.pl

#!/usr/local/bin/activeperl
use strict;
use warnings;
use List::Util 'shuffle';

my @char = qw/( ) { } [ ] . ^ ? ~ !/;
my $dict;
for my $a (shuffle @char) {
    for my $b (shuffle @char) {
        for my $c (shuffle @char) {
            for my $d (shuffle @char) {
                push @{$dict->{$a^$b^$c^$d}}, [$a, $b, $c, $d];
            }
        }
    }
}

my @str;
for (split //, 'map eval q#$a=1;map$a*=$_,1..$_;print"$_! = $a\n"#, 1..$ARGV[0]||1') {
    my @arr = shuffle @{ (map $_->[0], sort { $b->[1] <=> $a->[1] } map { [$_, scalar(my @a = join('', @$_)=~/[(){}]/g)] } @{ $dict->{$_} })[0] };
    for (0..3) {
        $str[$_] .= $arr[$_];
    }
}
print q/''!~('(?{'.('/ . join(q/'^'/, @str) . q/').'})')/;