File Coverage

blib/lib/HTML/Template/Compiled/Plugin/HTML_Tags.pm

Criterion	Covered	Total	%
statement	85	86	98.8
branch	12	16	75.0
condition	6	12	50.0
subroutine	19	19	100.0
pod	1	1	100.0
total	123	134	91.7

package HTML::Template::Compiled::Plugin::HTML_Tags;
# $Id: HTML_Tags.pm,v 1.17 2007/10/27 11:33:29 tinita Exp $
use strict;
use warnings;
use Carp qw(croak carp);
use HTML::Template::Compiled::Expression qw(:expressions);
use HTML::Template::Compiled;
HTML::Template::Compiled->register('HTML::Template::Compiled::Plugin::HTML_Tags');
our $VERSION = '0.05';

sub register {
    my ($class) = @_;
    my %plugs = (
        tagnames => {
            HTML::Template::Compiled::Token::OPENING_TAG() => {
                HTML_OPTION => [sub { exists $_[1]->{NAME} }, qw(NAME)],
                HTML_SELECT => [sub { exists $_[1]->{NAME} }, qw(NAME SELECT_ATTR)],
                HTML_TABLE  => [
                    sub { exists $_[1]->{NAME} },
                    qw(NAME TH_ATTR TD_ATTR TR_ATTR TABLE_ATTR HEADER)
                ],
                HTML_OPTION_LOOP => [sub { exists $_[1]->{NAME} }, qw(NAME)],
                HTML_BOX_LOOP    => [sub { exists $_[1]->{NAME} }, qw(NAME)],
            },
            HTML::Template::Compiled::Token::CLOSING_TAG() => {
                HTML_OPTION_LOOP => [undef, qw(NAME)],
                HTML_BOX_LOOP    => [undef, qw(NAME)],
            },
        },
        compile => {
            HTML_SELECT => {
                open => \&_html_select,
            },
            HTML_OPTION => {
                open => \&_html_option,
            },
            HTML_TABLE => {
                open => \&_html_table,
            },
            HTML_OPTION_LOOP => {
                open => \&_html_option_loop,
                close => \&_html_option_loop_close,
            },
            HTML_BOX_LOOP => {
                open => \&_html_box_loop,
                close => \&_html_option_loop_close, # sic!
            },
        },
    );
    return \%plugs;
}

sub _html_option_loop_close {
    return <<'EOM';
    }
 }
EOM
}

sub _option_loop {
    my ($select_string, $var) = @_;
    my @var = @{ $var };
    my $selected = shift @var;
    my %selected = defined $selected
        ? ref $selected eq 'ARRAY'
        ? (map { $_ => 1 } @$selected)
        : ($selected => 1)
        : ();
    my @options;
    for (@var) {
        push @options,  {
            value => $_->[0],
            label => $_->[1],
            selected => $selected{$_->[0]} ? qq#$select_string="$select_string"# : '',
        };
    }
    return \@options;
}

sub _html_box_loop {
    my ($htc, $token, $args) = @_;
    my $attr = $token->get_attributes;
    my $varstr = $htc->get_compiler->parse_var($htc,
        var => $attr->{NAME},
        method_call => $htc->method_call,
        deref => $htc->deref,
        formatter_path => $htc->formatter_path,
    );
    my $expression = <<"EOM";
\{
    my \$items = HTML::Template::Compiled::Plugin::HTML_Tags::_option_loop(
        "checked",
        $varstr,
    );
for my \$_html_option_loop_entry (\@\$items) {
    my \$C = \\\$_html_option_loop_entry;
EOM
}

sub _html_option_loop {
    my ($htc, $token, $args) = @_;
    my $attr = $token->get_attributes;
    my $varstr = $htc->get_compiler->parse_var($htc,
        var => $attr->{NAME},
        method_call => $htc->method_call,
        deref => $htc->deref,
        formatter_path => $htc->formatter_path,
    );
    my $expression = <<"EOM";
\{
    my \$items = HTML::Template::Compiled::Plugin::HTML_Tags::_option_loop(
        "selected",
        $varstr,
    );
for my \$_html_option_loop_entry (\@\$items) {
    my \$C = \\\$_html_option_loop_entry;
EOM
}

sub _html_table {
    my ($htc, $token, $args) = @_;
    my $OUT = $args->{out};
    my $attr = $token->get_attributes;
    my $varstr = $htc->get_compiler->parse_var($htc,
        var => $attr->{NAME},
        method_call => $htc->method_call,
        deref => $htc->deref,
        formatter_path => $htc->formatter_path,
    );
    my $header = $attr->{HEADER} || 0;
    my $tr_attr = $attr->{TR_ATTR} || '';
    my $td_attr = $attr->{TD_ATTR} || '';
    my $th_attr = $attr->{TH_ATTR} || '';
    my $table_attr = $attr->{TABLE_ATTR} || '';
    for ($tr_attr, $td_attr, $th_attr, $table_attr) {
        s/'/\\'/g;
    }
    my $expression = qq#my \@aoa = \@{ +$varstr };\n#;
    $expression .= <<"EOM";
    $OUT ''."\\n"; ', (map { # ', "\\n"; ', (map { ', "\\n"; 




141




 





 





 





 





 





 



 if ($header) \{ 




142




 





 





 





 





 





 



     my \$header = shift \@aoa; 




143




 





 





 





 





 





 



     $OUT join "", '




144




 





 





 





 





 





 



         qq#\$_




145




 





 





 





 





 





 



     } \@\$header), '




146




 





 





 





 





 





 



 \} 




147




 





 





 





 





 





 



 for (\@aoa) \{ 




148




 





 





 





 





 





 



     $OUT join "\\n", '




149




 





 





 





 





 





 



         qq#\$_# 




150




 





 





 





 





 





 



     } \@\$_), '




151




 





 





 





 





 





 



 \} 




152




 





 





 





 





 





 



 $OUT ''. "\\n";
if ($header) \{
    my \$header = shift \@aoa;
    $OUT join "", '
        qq#
    } \@\$header), '
\}
for (\@aoa) \{
    $OUT join "\\n", '
        qq#
    } \@\$_), '
\}
$OUT '
EOM
    return $expression;
}

sub _html_select {
    my ($htc, $token, $args) = @_;
    my $OUT = $args->{out};
    my $attr = $token->get_attributes;
    my $varstr = $htc->get_compiler->parse_var($htc,
        var => $attr->{NAME},
        method_call => $htc->method_call,
        deref => $htc->deref,
        formatter_path => $htc->formatter_path,
    );
    my $select_attr = $attr->{SELECT_ATTR} || '';
    $select_attr =~ s/'/\\'/g;
    my $expression = qq#\{\nmy \$var = $varstr;\n#;
    $expression .= qq#my \$attr = '$select_attr';\n#;
    $expression .= <<'EOM';
    my $name = $var->{name};
    my $value = $var->{value};
    my @options = @{ $var->{options} };
    my $select = qq#\n#;
    $select .= HTML::Template::Compiled::Plugin::HTML_Tags::_options($value, @options);
    $select .= qq#\n\n#;
EOM
    $expression .= qq#$OUT \$select;\n\}#;
    return $expression;
}

sub _html_option {
    my ($htc, $token, $args) = @_;
    my $OUT = $args->{out};
    my $attr = $token->get_attributes;
    my $varstr = $htc->get_compiler->parse_var($htc,
        var => $attr->{NAME},
        method_call => $htc->method_call,
        deref => $htc->deref,
        formatter_path => $htc->formatter_path,
    );
    my $expression = qq!
my \$aref = $varstr;
my \@aoa = \@\$aref;
!;
    $expression .= <<'EOM';
my $options = HTML::Template::Compiled::Plugin::HTML_Tags::_options(@aoa);
EOM
    $expression .= qq#$OUT \$options;\n#;
    return $expression;
}

sub _options {
    my @aoa = @_;
    my $selected = shift @aoa;
    my %selected = defined $selected
    ? ref $selected eq 'ARRAY'
    ? (map { $_ => 1 } @$selected)
    : ($selected => 1)
    : ();
    my $options = join "\n", map {
        unless (ref $_ eq 'ARRAY') {
            # values and labels should be equal
            $_ = [$_, $_];
        }
        my $escaped = HTML::Template::Compiled::Utils::escape_html($_->[0]);
        my $sel = $selected{ $_->[0] } ? 'selected="selected"' : '';
        my $escaped_display = @$_ > 1
            ? HTML::Template::Compiled::Utils::escape_html($_->[1])
            : $escaped;
        qq#$escaped_display#;
    } @aoa;
}



1;

__END__