PostScript風なテンプレート・プロセッサの続き(その2)

せっかくなので、お手軽テンプレート HAML を参考にしつつ、もう少し使いやすくしようとあがいてみます。3月バージョンに比べたら、冗長性は改善したとはいえ、フォームを記述しようとすると、いまだに面倒です。例えば、HAML では次のように簡潔に記述できます。

%form{:action=>entry_post_link, :method=>"post"}
  %input{:name=>"foo", :type=>"text", :value=>field_foo}/
  %input{:name=>"bar", :type=>"checkbox", :checked=>field_bar}/

上と同じ結果を得ようとすると、大げさな記述になってしまいます。

<form action="[% var /entry_post_link uri_get %]" method="post">
<input name="foo" type="text" value="[% var /field_foo htmlall_get %]" />
<input name="bar" type="checkbox" [% field_bar { %]checked="checked"[% } if %] />
</form>

せめて、これを次のようにしたいものです。

<form [% action= entry_post_link method= /post %]>
<input [% name= /foo type= /text value= field_foo %] />
<input [% name= /var type= /checkbox checked= field_bar %] />
</form>

等号で終わるオペレータは、属性を表す文字列を作ってデータ・スタックへ置くことにします。後置記法っぽくない書き方なのは、後続するオペランドの扱いがオペレータによって変化する特殊形式だからです。action= は変数オペランドを escape_uri でゲットし、value= は escape_htmlall でゲットします。checked= は変数オペランドの値の真偽で属性の有無を決めます。
まず、_apply_block 手続きの末尾にある変数値をデータ・スタックへ置く箇所の、いまいちいけてない部分を潰します。

+        push @{$data}, _fetch($param, $op, \&escape_html);
-        if (! ref $data->[-1]
-            && $data->[-1] =~ m/[ \t\n\r](?:href|src|action)="\z/msx
-        ) {
-            push @{$data}, _fetch($param, $op, \&escape_uri);
-        }
-        else {
-            push @{$data}, _fetch($param, $op, \&escape_html);
-        }
     }

同手続きの while ループに等号で終わる属性オペレータを扱えるように追加します。$ALNUMエスケープ関数用のものを流用することにして、コードの先頭あたりに移動しておくことにします。

         if (q(/) eq (substr $op, 0, 1) && length $op > 1) {
             push @{$data}, (substr $op, 1);
             next;
         }
+        if ($op =~ m{\A([$ALNUM:_-]+)=\z}mosx) {
+            my $attribute = $1;
+            my $value = _opland($block->[$pc++], $param);
+            _attribute($data, $attribute, $value);
+            next;
+        }
         if (looks_like_number($op)) {
             push @{$data}, $op;
             next;
         }

属性オペレータに続くオペランドを評価し、その結果で属性を作ってデータ・スタックへ置きます。オペランドには、変数、リテラル、数字、ついでにブロックも記述できるようにしてみます。

sub _opland {
    my($opland, $param) = @_;
    if (ref $opland) {
        my $a = _apply_block([], $opland, $param);
        return join q(), @{$a};
    }
    if (q(/) eq (substr $opland, 0, 1)) {
        return substr $opland, 1;
    }
    if (looks_like_number($opland)) {
        return $opland;
    }
    return $param->{$opland}
}

属性を作る手続きでは、属性によってエスケープ関数を切り替えて文字列を作成してデータ・スタックへ置きます。

my %ATTRIBUTE_TYPE = (
    'href' => 'uri',
    'src' => 'uri',
    'action' => 'uri',
    'value' => 'htmlall',
    'compact' => 'bool',
    'nowrap' => 'bool',
    'ismap' => 'bool',
    'declare' => 'bool',
    'noshade' => 'bool',
    'checked' => 'bool',
    'disabled' => 'bool',
    'readonly' => 'bool',
    'multiple' => 'bool',
    'selected' => 'bool',
    'noresize' => 'bool',
    'defer' => 'bool',
);

sub _attribute {
    my($data, $attribute, $value) = @_;
    my $type = $ATTRIBUTE_TYPE{$attribute} || 'html';
    if ($type eq 'uri') {
        push @{$data}, qq( $attribute=") . escape_uri($value) . q("); 
    }
    elsif ($type eq 'htmlall') {
        push @{$data}, qq( $attribute=") . escape_htmlall($value) . q(");
    }
    elsif ($type eq 'bool') {
        if ($value) {
            push @{$data}, qq( $attribute="$attribute");
        }
    }
    else {
        push @{$data}, qq( $attribute=") . escape_html($value) . q(");
    }
    return;
}

PostScript風なテンプレート・プロセッサの続き(その3)