10種類の記号で書くPerlワンライナーの作り方

java-ja温泉にて、Pythonのワンライナーがキモいという話が出ていて、Perlだってこれくらいキモいの書けるよ！とアピールしてみた

perl -e '""!~("(?{".("{^(?)!(?^{^^!){.^^~~?}{!~}^}^.(!~}!..^^!~}!~~.~^}"^"^}((~))~~^{.{^~?}^!^}(~{^)?()^)^!).^}!()){.^)(}.("^"!~!{}(!(!~((}}!})!^^{^){(.?}{}!~{^~!)^?..(~)!~.?."^"{{?}^(~)~^!..~)??){^.~){.~(!{.)}}^.}^~}?}.^}(^?{~"^".)^!?^(.)!~!)~{^{(}){?!^.~)({?)(^.^!.^{((^!!^(^(!"^"!})^?}^(?^(~{.)(}})!.?^~!!{~))}({^^!..)^^~?{.?)..")."})")'

http://gist.github.com/339237

"
{
}
(
)
^
?
!
~
.

の、実質10種類の記号だけで書くFizzBuzz ワンライナー。

作り方は、Perlの記号化の常套手段である"排他的論理和で作成した文字列を拡張正規表現でevalする"だけ。以下が詳しいです
2006-11-07 - 兼雑記
ある程度の種類の記号を使えば2~3文字くらいの組み合わせで[\x00-\x7F]の文字が作れるのだけど、6文字組み合わせれば上記の記号(ダブルクォートは除外)だけでも128種類全部作れるようだ。[\x80-\xFF]の範囲は単純にビット反転してやればOK。
で、作って繋げてevalさせるようにして(これはしなくても大丈夫なのかも。よくわかってない)拡張正規表現の構文にあてはめてワンライナー形式で出力させる。
出来たのが以下。引数に指定したPerlプログラムを記号ワンライナー化します。

#!/usr/bin/perl
use strict;
use warnings;
use File::Slurp;
use List::Util qw/shuffle/;

my @chr = qw/ ! ~ ( ) ? { } ^ . /;
my %hash = ();
for my $c1 (@chr) {
    for my $c2 (@chr) {
        for my $c3 (@chr) {
            for my $c4 (@chr) {
                for my $c5 (@chr) {
                    for my $c6 (@chr) {
                        my $chr = $c1 ^ $c2 ^ $c3 ^ $c4 ^ $c5 ^ $c6;
                        $hash{$chr} ||= [];
                        push @{ $hash{$chr} }, [ $c1, $c2, $c3, $c4, $c5, $c6 ];
                    }
                }
            }
        }
    }
}

sub symbolize_ascii {
    my $ascii = shift;
    my @strings;
    for my $chr (split //, $ascii) {
        my @arr = shuffle @{ shuffle @{$hash{$chr}} };
        for (0 .. 5) {
            $strings[$_] .= $arr[$_];
        }
    }
    return q/("/ . join(q/"^"/, @strings) . q/")/;
}

my $filetext = read_file(shift);
my $to_escape = quotemeta q/"$@{}\\/;
$filetext =~ s{ [$to_escape] }
              {\\$&}xmsg;
$filetext = qq/eval"$filetext"/;
$filetext =~ s{ [\x00-\x7F]+ }
              { '.'  . symbolize_ascii($&) }xmseg;
$filetext =~ s{ [\x80-\xFF]+ }
              { '.~' . symbolize_ascii(~$&) }xmseg;
print qq/perl -e '""!~("(?{"$filetext."})")'/;

$ cat > hoge.pl
print "こんにちは！\n";
$ perl symbolize.pl hoge.pl
perl -e '""!~("(?{".("?{^).(}{{){({"^"{.}{{^.?}~)})"^"~~{^.})!^}~!("^"^^?!)}^)(^{.}"^"(~(?^}({!!^{^"^")}.~.{~^?!)}{").~(")(~~~?~!.)!)?}.))!"^"(?^.}^.(^!~(.!{(?^"^"}){?^{{)^.^~)({?)~"^"~^!{!)){){).{})..~"^"???!(~!{{~~!!)~^))"^"!!)))!?^(?(.~^)^{(").("{!!}{?.."^"^)?..{^^"^"^)^!^{{~"^".~.!(^!)"^"!})!({~~"^"(~).)!^{")."})")'

$ perl -e '""!~("(?{".("?{^).(}{{){({"^"{.}{{^.?}~)})"^"~~{^.})!^}~!("^"^^?!)}^)(^{.}"^"(~(?^}({!!^{^"^")}.~.{~^?!)}{").~(")(~~~?~!.)!)?}.))!"^"(?^.}^.(^!~(.!{(?^"^"}){?^{{)^.^~)({?)~"^"~^!{!)){){).{})..~"^"???!(~!{{~~!!)~^))"^"!!)))!?^(?(.~^)^{(").("{!!}{?.."^"^)?..{^^"^"^)^!^{{~"^".~.!(^!)"^"!})!({~~"^"(~).)!^{")."})")'
こんにちは！

ちゃんと実行できますね。

ちなみに、上記スクリプトそのものを記号ワンライナー化したらこんなんなりました。
http://gist.github.com/339258
8308バイトくらいになってしまって、僕の環境だとターミナルにうまくコピペできず＞＜
emacsのshell-commandでは動作確認できたので、多分あってるはず。