File Coverage

lib/CGI/FormBuilder/Template/CGI_SSI.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::CGI_SSI;

=head1 NAME

CGI::FormBuilder::Template::CGI_SSI - FormBuilder interface to CGI::SSI

=head1 SYNOPSIS

    my $form = CGI::FormBuilder->new(
                    fields   => \@fields,
                    template => {
                      type => 'CGI_SSI',
                      file => "template.html",
                    },
               );

=cut

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

use CGI::FormBuilder::Util;
use CGI::SSI;
use base 'CGI::SSI';


our $VERSION = '3.10';

#
# For legacy reasons, and due to its somewhat odd interface,
# CGI::SSI 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

    my %opt2 = %$opt;
    delete $opt2{virtual};
    delete $opt2{file};
    delete $opt2{string};
    $opt->{engine} = CGI::SSI->new(%opt2);

    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: "
    #
    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, "