File Coverage

lib/CGI/FormBuilder/Template/HTML.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

###########################################################################
# Copyright (c) Nate Wiger http://nateware.com. All Rights Reserved.
# Please visit http://formbuilder.org for tutorials, support, and examples.
###########################################################################

package CGI::FormBuilder::Template::HTML;

=head1 NAME

CGI::FormBuilder::Template::HTML - FormBuilder interface to HTML::Template

=head1 SYNOPSIS

    my $form = CGI::FormBuilder->new(
                    fields   => \@fields,
                    template => 'form.tmpl',
               );

=cut

use Carp;
use strict;
use warnings;
no  warnings 'uninitialized';

use CGI::FormBuilder::Util;
use HTML::Template;
use base 'HTML::Template';


our $VERSION = '3.10';

#
# For legacy reasons, and due to its somewhat odd interface,
# HTML::Template vars use a completely different naming scheme.
#
our %FORM_VARS = (
    'js-head'       =>  'jshead',
    'form-title'    =>  'title',
    'form-start'    =>  'start',
    'form-submit'   =>  'submit',
    'form-reset'    =>  'reset',
    'form-end'      =>  'end',
    'form-invalid'  =>  'invalid',
    'form-required' =>  'required',
);

our %FIELD_VARS = map { $_ => "$_-%s" } qw(
    field
    value
    label
    type
    comment
    required
    error
    invalid
    missing
    nameopts
    cleanopts
);

sub new {
    my $self  = shift;
    my $class = ref($self) || $self;
    my $opt   = arghash(@_);

    $opt->{die_on_bad_params} = 0;    # force to avoid blow-ups
    $opt->{engine} = HTML::Template->new(%$opt);

    return bless $opt, $class;     # rebless
}

sub engine {
    return shift()->{engine};
}

sub render {
    my $self = shift;
    my $tvar = shift || puke "Missing template expansion hashref (\$form->prepare failed?)";

    while(my($to, $from) = each %FORM_VARS) {
        debug 1, "renaming attr $from to: ";
        $tvar->{$to} = "$tvar->{$from}";
    }

    #
    # For HTML::Template, each data struct is manually assigned
    # to a separate  and  tag
    #
    my @fieldlist;
    for my $field (@{$tvar->{fields}}) {

        # Field name is usually a good idea
        my $name = $field->{name};
        debug 1, "expanding field: $name";

        # Get all values
        my @value   = @{$tvar->{field}{$name}{values}  || []};
        my @options = @{$tvar->{field}{$name}{options} || []};

        #
        # Auto-expand all of our field tags, such as field, label, value
        # comment, error, etc, etc
        #
        my %all_loop;
        while(my($key, $str) = each %FIELD_VARS) {
            my $var = sprintf $str, $name;
            $all_loop{$key} = $tvar->{field}{$name}{$key};
            $tvar->{$var}   = "$tvar->{field}{$name}{$key}";   # fuck Perl
            debug 2, " = " . $all_loop{$str};
        }

        #
        # Create a  for multi-values/multi-opts
        # we can't include the field, really, since this would involve
        # too much effort knowing what type
        #
        my @tmpl_loop = ();
        for my $opt (@options) {
            # Since our data structure is a series of ['',''] things,
            # we get the name from that. If not, then it's a list
            # of regular old data that we _toname if nameopts => 1
            debug 2, "looking at field $name option $opt";
            my($o,$n) = optval $opt;
            $n ||= $tvar->{"nameopts-$name"} ? toname($o) : $o;
            my($slct, $chk) = ismember($o, @value) ? ('selected', 'checked') : ('','');
            debug 2, " = adding { label => $n, value => $o }";
            push @tmpl_loop, {
                label => $n,
                value => $o,
                checked => $chk,
                selected => $slct,
            };
        }

        # Now assign our loop-field
        $tvar->{"loop-$name"} = \@tmpl_loop;

        # Finally, push onto a top-level loop named "fields"
        push @fieldlist, {
            field   => $all_loop{field},
            value   => $all_loop{value},
            values  => [ @value ],
            options => [ @options ],
            label   => $all_loop{label},
            comment => $all_loop{comment},
            error   => $all_loop{error},
            required=> $all_loop{required},
            missing => $all_loop{missing},
            fieldset=> $all_loop{fieldset},
            loop    => [ @tmpl_loop ],
        };
    }
    # kill our previous fields list
    $tvar->{fields} = \@fieldlist;

    # loop thru each field we have and set the tmpl_param
    while(my($param, $tag) = each %$tvar) {
        $self->{engine}->param($param => $tag);
    }

    # template output
    return $self->{engine}->output;
}

1;
__END__