ワンライナー記号化スクリプトを書いた

何かの拍子にこの記事を見かけてしまい、衝撃を受けた。
2006-11-07 - 兼雑記
Perlってこんな変態プログラムが書けてしまうのか…！！と。
記号だけでプログラムが書けてしまうとは全然知らなかった。
何度も読み返してようやく理解した範囲では、

• 拡張正規表現の構文を利用して任意のコードを実行させる
• 文字列は文字列同士の排他的論理和をとることで生成できる

ということらしい。

なので、「どの文字とどの文字の排他的論理和がどの文字になるか」を把握していれば、そこから文字列を生成することができるわけで、自分でもこうした記号プログラムが書けるのではないか？と思って、作ってみた。
任意のワンライナーを記号で表現しなおすためのスクリプト。(2/8 ちょっと修正)

#!/usr/bin/perl
use strict;
use warnings;

# 変換辞書
my $dict = &create_dictionary();
# ワンライナー文字列
my $str = shift;

# 作成不可能な文字
my $impossibles = q|()*+,-./0-9:|;
# ワンライナーが記号化可能な文字から始まるかどうか判定
my $flg = $str =~ /^[$impossibles]/ ? 1 : 0;
my $output = '.';

while ($str) {
    my $pattern;
    # 文字列を抜き出す
    if ($flg) {
        $str =~ /[$impossibles]+/;
        $pattern = $&;
        # 作成不可能な文字列は""で囲むだけ
        $output .= qq|"$&".|;
    } else {
        $str =~ /[^$impossibles]+/;
        $pattern = $&;
        # 記号化可能な文字列は記号化する
        $output .= &symbolization($&) . '.';
    }
    # フラグの切り替え
    $flg = !$flg;

    # 取り出したパターンを消去
    $str = substr($str, length($pattern));
}

# 最終出力
print qq|perl -e '""!~("(?{"$output"})")'\n|;


# 辞書の作成
sub create_dictionary {
    # ワンライナーに使う文字のみを取り出す
    my @char = grep { /[^\da-zA-Z\\'"]/ } map { chr } (0x21..0x7E);
    my $dict = {};

    for my $lhs (@char) {
        for my $rhs (@char) {
            my $xor = ($lhs ^ $rhs);
            my $ord = ord $xor;
            # 表示可能な文字の場合のみ
            if ($ord >= 0x20 and $ord <= 0x7E) {
                my $array = $dict->{$xor};
                if (defined $array) {
                    push @$array, [$lhs, $rhs];
                } else {
                    $dict->{$xor} = [[$lhs, $rhs]];
                }
            }
        }
    }

    return $dict;
}


# 文字列の記号化
sub symbolization {
    my $arg = shift or die $!;
    my ($lhs, $rhs) = ('', '');

    # 引数を一文字ずつ取り出して変換
    for (0..length($arg) - 1) {
        my $char = substr($arg, $_, 1);
        my $next = substr($arg, $_ + 1, 1);
        if ($dict->{$char}) {
            my $array = $dict->{$char};
            my ($lappend, $rappend);
          LOOP: while (1) {
                my $set = $array->[rand @$array];
                $lappend = $set->[0];
                $rappend = $set->[1];
                # '@_', '$_', '@$' などが含まれていると
                # ""内で展開しようとしてしまうのでやり直す
                # '$'は後でまとめてエスケープする
                for my $word (qw/@_ @+ @- @: @$ @{/) {
                    next LOOP if index($lhs.$lappend, $word) + 1;
                    next LOOP if index($rhs.$rappend, $word) + 1;
                }
                # '$'の変換は ("_"^"{") しかないので
                # '@'の後にくると無限ループになってしまう
                if (($lappend eq '@' || $rappend eq '@') and $next eq '$') {
                    next LOOP;
                }
                last;
            }
            $lhs .= $lappend;
            $rhs .= $rappend;
        }
    }
    # '$'のエスケープ
    $lhs =~ s|\$|\\\$|g;
    $rhs =~ s|\$|\\\$|g;

    return qq|("$lhs"^"$rhs")|;
}

正規表現がイマイチ使いこなせず、かなり苦労している…orz
いちおう、これを使えば、ワンライナーを記号化できる、はず。

例１：Hello world

$ ./symbolize.pl 'print "Hello world!\n"'
perl -e '""!~("(?{".("+,@.)]}(>,,/^_@/@?|!@^"^"[^)@]}_`[@@@~(/],[]}.|")."})")'

↓ コピペ

$ perl -e '""!~("(?{".("+,@.)]}(>,,/^_@/@?|!@^"^"[^)@]}_`[@@@~(/],[]}.|")."})")'
Hello world!

例２：モジュールのロードだってできるよ

$ ./symbolize.pl 'use Data::Dumper; print Dumper { hoge => foo, fuga => bar }'
perl -e '""!~("(?{".("+_>@~>]<"^"^,[`:_)]")."::".("?_--%[[`-_@@*~?[--:]^_{@@<%}}~}&@@"^"{*@]@)`@]-).^^{.@]_/~\$[(/[@]@@]@//").",".("@=.<:`}@[]^,@#"^"`[[[[@@~{??^`^")."})")'

↓ コピペ

$ perl -e '""!~("(?{".("+_>@~>]<"^"^,[`:_)]")."::".("?_--%[[`-_@@*~?[--:]^_{@@<%}}~}&@@"^"{*@]@)`@]-).^^{.@]_/~\$[(/[@]@@]@//").",".("@=.<:`}@[]^,@#"^"`[[[[@@~{??^`^")."})")'
$VAR1 = {
          'fuga' => 'bar',
          'hoge' => 'foo'
        };

と。

ただし、このスクリプトで作成している辞書をDumpしてみれば分かる通り、'()*+,-./0123456789:'の文字は記号同士の排他的論理和では作成することが出来ない。
まぁ'+-*/'とかはそのまま出力すればいいんだけど、数字が作れないのには困ってしまう。
排他的論理和じゃなくて論理積を使えば8と9だけは作れるようになるけど、それはそれで他のアルファベットなどが作れなくなってしまうし。
いまのところこのスクリプトではそこは未解決なので数字はそのまま使われてしまう。

例：さいころワンライナー

$ perl ./symbolize.pl 'print int(rand 6) + 1, "\n"'
perl -e '""!~("(?{".("],@@]^@.^"^"-^).)~)@*")."(".("/!@@^"^"]@.\$~")."6)".("^"^"~")."+".("@"^"`")."1,".("}^}@}"^"]|!._")."})")'

6と1がそのまま使われてしまう…

この場合どうすればいいんだろう。
とりあえず入力のワンライナー側で数字を使わないようにするしか。

$ perl ./symbolize.pl 'print int(rand length $~) + !$[, "\n"'
perl -e '""!~("(?{".("-^@@)~@.]"^"],).]^)@)")."(".("__@?@@>.<]({_#"^"->.[`,[@[)@[{]").")".("{"^"[")."+".("}~_;"^"]_{`").",".("[^!.|"^"{|}@^")."})")'

デフォルト値が$~ = 'STDOUT', $[ = 0 なのを利用して文字列の長さや論理否定で数字を作る荒技。。。

0 = $[
1 = !$[
2 = !$[<<!$[

というカンジで置き換えてやる、というのが今のところ思いつく方法。
他に何か良い手はないかなぁ。