スーパーpre記法でこんにちはこんにちは!!

Re: スーパー pre 記法で実行可能な JavaScript を - IT戦記というエントリーのスーパーpre executable記法*1Text::Hatena 0.20を使って実装してみました。ついでにスーパーpre記法で色が付くようにしてみたけど*2失敗。

作ってはみたもののやっぱり実際にはてなで実装されることはなさそうな予感。自分で使う分にはちょっとは便利かもしれない。

package MyParser;
use strict;
use warnings;
use base qw/Text::Hatena/;

__PACKAGE__->syntax(q{
    block     : h5       | h4        | blockquote | dl    | list
              | exec_pre | super_pre | pre        | table | cdata
              | p
    exec_pre  : /\n>\|\w+\|/o exec_line(s) "\n|executable|<" ..."\n"
    exec_line : ...!"\n|executable|<\n" "\n" /[^\n]*/o
});

sub exec_pre {
    my $class = shift;
    my $items = shift->{items};
    my $texts = $class->expand($items->[1]);
    my $exec_button = qq/<input type="submit" value="実行" onclick="try{confirm('このコードは危険かもしれません。信頼できるサイトである場合意外は実行しないでください。')?eval(this.previousSibling.value):void(0);}catch(e){alert(e)}">\n/;

    return qq(<pre class="executable">\n$texts</pre>\n<textarea style="display: none;">\n(function(){\nalert($texts)})()\n</textarea>$exec_button);
}

sub exec_line {
    my $class = shift;
    my $text = shift->{items}->[2];
    return "$text\n";
}

sub super_pre {
    my $class = shift;
    my $items = shift->{items};
    my $texts = _format_plain($class->expand($items->[1]));
    my ($filetype) = $items->[0] =~ /\n>\|(.*?)\|/;
    if ($filetype) {
        eval { require Text::VimColor };
        warn $@ if $@;
        $texts = Text::VimColor->new(
            string   => $texts,
            filetype => $filetype,
        )->html;
    }
    return qq{<pre class="syntax-highlight">\n$texts</pre>\n};
}

sub _format_plain {
    my $s = shift;
    $s =~ s/\&/\&amp;/g;
    $s =~ s/</\&lt;/g;
    $s =~ s/>/\&gt;/g;
    $s =~ s/"/\&quot;/g;
    $s =~ s/\'/\&#39;/g;
    $s =~ s/\\/\&#92;/g;
    return $s;
}

1;

*1:勝手に命名

*2:0.20ではTODOになってる