簡略 Mustache

Mustache からパラメータ置換機能に機能を絞った簡略 Mustache テンプレート・エンジンを C++11 だけでなく、Perl でも使えるようにします。C++11 用の wmustache はセクションの外側のハッシュの値を得ることができましたが、 Perl 版では環境を使わずセクションで外側のハッシュの値を参照するのを諦めることで、コードを単純にしています。

{{key}}             HTML エスケープして置換
{{{key}}}           エスケープなしで置換
{{&key}}            エスケープなしで置換
{{#key}}..{{/key}}  セクション
{{^key}}..{{/key}}  ELSE セクション

ここで、key はワードの文字 (\w) に限定します。 さらに、key の前後にスペースを許しません。

テンプレート文字列をクラス・メソッド new に渡します。 new はソースから命令コード列を生成します。new はテンプレート文字列としは、文字列スカラかスカラ・リファレンスの両方を受け付けます。

2015 年 8 月 28 日修正 new にスカラ・リファレンスも渡せるようにしました。

package Mustache;
use strict;
use warnings;
use Carp;
use Scalar::Util qw(reftype);

sub new {
    my($class, $arg) = @_;
    my $refsrc = (! defined reftype $arg) ? \$arg : $arg;
    my $code = $class->assemble($refsrc);
    return bless {'code' => $code}, ref $class || $class;
}

#@<assemble を定義します@>
#@<render を定義します@>

1;

命令コードは、フラットな配列に並びます。マークアップと 1 対 1 に対応する命令コードが存在します。セクションの始まりを示す 2 つの命令コードは、 セクション終端の次の命令の格納アドレスを addr 欄にもっています。

[
    0, 'plain text',
    1, 'key',           # {{{key}}}
    2, 'key',           # {{key}}
    3, 'key'            # {{/key}}
    4, 'key', $addr,    # {{^key}}
    5, 'key', $addr,    # {{#key}}
]

assemble クラス・メソッドは、 Mustache マークアップを命令コードへ変換します。入れ子のセクションはスタックで追跡します。スタックにセクション開始命令のアドレスをプッシュし、セクション終了命令で、スタックからポップして対応する開始命令のアドレスを得ます。そして、対応するセクション開始命令の addr 欄に終了命令の次の命令のアドレスを書き込みます。

#@<assemble を定義します@>=
sub assemble {
    my($class, $refsrc) = @_;
    my %opcode = (q{&} => 1, q{ } => 2, q{/} => 3, q{^} => 4, q{#} => 5);
    my @code;
    my @stack;
    while (${$refsrc} =~ m{\G
        (.*?)\{\{(?:([\#^/&])(\w+)\}\}\n?|(\w+)\}\}|\{(\w+)\}\}\})
    }gcomsx) {
        $1 ne q{} and push @code, 0, $1;
        my $sigil = defined $4 ? q{ } : defined $5 ? q{&} : $2;
        my $key = $+;
        my $op = $opcode{$sigil};
        if ($op < 3) {
            push @code, $op, $key;      # {{{key}}} {{key}}
        }
        elsif ($op > 3) {
            push @stack, $#code + 1;
            push @code, $op, $key, 0;   # {{#key}} {{^key}}
        }
        elsif ($op == 3) {
            my $dot = pop @stack;
            $code[$dot + 1] eq $key or croak "Mustache syntax error";
            push @code, $op, $key;      # {{/key}}
            $code[$dot + 2] = scalar @code;
        }
    }
    if ((pos ${$refsrc}) != (length ${$refsrc})) {
        my $txt = substr ${$refsrc}, (pos ${$refsrc});
        push @code, 0, $txt;
    }
    @stack and croak "Mustache syntax error";
    return \@code;
}

render メソッドは、パラメータ $param を使ってテンプレート命令コードを実行します。セクションの実行条件を満たすと、命令コードの addr 欄からセクション終了命令の次のアドレスを求め、セクションの render を再帰的におこないます。

#@<render を定義します@>=
sub render {
    my($self, $param, $begin, $end) = @_;
    $param ||= {};
    $begin = defined $begin ? $begin : 0;
    $end = defined $end ? $end : $#{$self->{'code'}} + 1;
    my $out = q();
    my $ip = $begin;
    while ($ip < $end) {
        my $op = $self->{'code'}[$ip];
        if ($op == 0) {
            $out .= $self->{'code'}[$ip + 1];
            $ip += 2;
            next;
        }
        my $key = $self->{'code'}[$ip + 1];
        my $ip_next = $op < 4 ? $ip : $self->{'code'}[$ip + 2] - 2;
        my $ip_section = $ip + 3;
        if (! exists $param->{$key}) {
            if (4 == $op) {
                $out .= $self->render($param, $ip_section, $ip_next);
            }
        }
        elsif (! defined reftype $param->{$key}) {
            if (1 == $op && defined $param->{$key}) {
                $out .= $param->{$key};
            }
            elsif (2 == $op && defined $param->{$key}) {
                $out .= escape_htmlall ($param->{$key});
            }
            elsif (4 == $op && ! $param->{$key}) {
                $out .= $self->render($param, $ip_section, $ip_next);
            }
            elsif (5 == $op && $param->{$key}) {
                $out .= $self->render($param, $ip_section, $ip_next);
            }
        }
        elsif ('SCALAR' eq (reftype $param->{$key})) {
            if (1 == $op) {
                $out .= ${$param->{$key}};
            }
            elsif (2 == $op) {
                $out .= escape_htmlall (${$param->{$key}});
            }
            elsif (4 == $op && ! ${$param->{$key}}) {
                $out .= $self->render($param, $ip_section, $ip_next);
            }
            elsif (5 == $op && ${$param->{$key}}) {
                $out .= $self->render($param, $ip_section, $ip_next);
            }
        }
        elsif ('HASH' eq (reftype $param->{$key})) {
            if (4 == $op && ! %{$param->{$key}}) {
                $out .= $self->render($param, $ip_section, $ip_next);
            }
            elsif (5 == $op && %{$param->{$key}}) {
                $out .= $self->render($param->{$key}, $ip_section, $ip_next);
            }
        }
        elsif ('ARRAY' eq (reftype $param->{$key})) {
            if (4 == $op && ! @{$param->{$key}}) {
                $out .= $self->render($param, $ip_section, $ip_next);
            }
            elsif (5 == $op) {
                for my $x (@{$param->{$key}}) {
                    $out .= $self->render($x, $ip_section, $ip_next);
                }
            }
        }
        $ip = $ip_next + 2;
    }
    return $out;
}

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

sub escape_htmlall {
    my($s) = @_;
    $s =~ s{([&<>"'])}{$XMLSPCEIAL{$1}}egmsx;
    return $s;
}