emit_block 改め nestag を使った簡易 Wiki フォーマッタ

元祖 Wiki サーバ・スクリプト WikiBase の Wiki フォーマッタ、 PrintBodyText 関数を元にして、 2 年前に書いたコードを久しぶりに改訂します。

https://gist.github.com/tociyuki/1388797

emit_block を使った簡易 Wiki フォーマッタ - Tociyuki::Diary
_emit_block メソッドのファクタリング - Tociyuki::Diary

書式は変えず、 定義リスト (dl)、 順番なしリスト (ul)、 順番ありリスト (ol)、 フォーマット済み (pre)、 水平区切り (hr)、 段落 (p)、 強調 (em と strong)、 WikiName のアンカー生成を扱います。

2年前から進歩して、入れ子の強調を正しく扱えるようにしました。 シングルクォーテーション 2 つで em を、 3 つで strong を表します。 まず、 2 つまたは 5 つの場合に限り、 シングルクォーテーションを em に置き換えます。 5 つの場合には、 em の両側を挟む形に 3 つのシングルクォーテーションを書き戻します。 続いて、 3 つを strong に置き換え、 さらに 2 つを em に置き換えます。

my %HTML_SPECIAL = (
    q{&} => q{&amp;}, q{<} => q{&lt;}, q{>} => q{&gt;},
    q{"} => q{&quot;}, q{'} => q{&#39;}, q{\\} => q{&#92;},
);

sub formatwiki {
    my($s) = @_;
    $s =~ s/(?:\r\n?|\n)/\n/gmsx;
    $s =~ tr/\t/ /;
    $s =~ s/\\\n[ ]*/ /gmsx;
    $s =~ s/[^\n \p{Graph}]//gmsx;
    $s =~ s{([&<>"\\])}{ $HTML_SPECIAL{$1} }egmsx;
    my $nest = [[0]];
    my $t = q();
    for (split /\n/msx, $s) {
        $t .= s{^[ ]*$}{}msx               ? nestag($nest, q())
            : s{^([ ]+)(.+):[ ]}{}msx      ? nestag($nest, $1, 'dl', 'dt') . $2
                                           . nestag($nest, $1, 'dl', 'dd')
            : s{^([ ]+)[*][ ]+}{}msx       ? nestag($nest, $1, 'ul', 'li')
            : s{^([ ]+)[0-9]+[.][ ]+}{}msx ? nestag($nest, $1, 'ol', 'li')
            : m{^[ ]}msx                   ? nestag($nest, q(), 'pre')
            : s{^-{4,}$}{}msx              ? nestag($nest, q()) . "\n<hr />\n"
            :                                nestag($nest, q(), 'p');
        s{(?<!['])['][']((?:['][']['])?)([^\s'][^']*?)(?<=\S)['][']((?:['][']['])?)(?!['])}
         {$1<em>$2</em>$3}gmsx; # 2013-11-26 修正
        s{[']['][']([^\s'][^']*?)(?<=\S)[']['][']}{<strong>$1</strong>}gmsx;
        s{['][']([^\s'][^']*?)(?<=\S)['][']}{<em>$1</em>}gmsx;
        s{((?:[A-Z][a-z]+){2,})}{<a href="/wiki/$1">$1</a>}gmsx;
        # s{(['])}{ $HTML_SPECIAL{$1} }egmsx; # 2013-11-15 修正
        $t .= $_;
    }
    $t .= nestag($nest, q());
    $t =~ s{(['])}{ $HTML_SPECIAL{$1} }egmsx; # 2013-11-15 修正
    $t =~ s/\A\n//msx;
    return $t;
}

nestag はスタックの $nest 配列リファレンスに副作用を及ぼしつつ、 HTML のタグを生成して返します。 その際、 stag の前と etag の後に改行文字を配置します。 また、 隣接する余計なタグを連結した場合に、それらを削り落とします。 これで、 emit_block で必要だったマークアップ生成用のハッシュが必要なくなりました。 ただし、dl は dt と dd をそれぞれ出力しなければならなくなり、 dt と dd の間に改行が生成されるようになりました。

sub nestag {
    my($nest, $indent, @stag) = @_;
    my $level = length $indent;
    my $t = q();
    while (@{$nest} > 1 && $level < $nest->[-1][0]) {
        if ($nest->[-2][0] < $level) {
            $nest->[-1][0] = $level;
            last;
        }
        my(undef, @etag) = @{pop @{$nest}};
        $t .= join q(), map { "</$_>\n" } reverse @etag;
    }
    if ($nest->[-1][0] < $level) {
        push @{$nest}, [$level, @stag];
        $t .= join q(), map { "\n<$_>" } @stag;
    }
    else {
        my(undef, @etag) = @{$nest->[-1]};
        @{$nest->[-1]} = ($level, @stag);
        my $x = (join q(), map { "</$_>\n" } reverse @etag)
              . (join q(), map { "\n<$_>" } @stag);
        $x =~ s{</([dou]l)>\n\n<\1>\n}{}gmsx;
        $x =~ s{</(p(?:re)?)>\n\n<\1>}{\n}gmsx;
        $t .= $x;
    }
    return $t;
}