#!/usr/bin/perl -I.
use strict;
use vars qw($TESTING $DEBUG $SKIP);
$TESTING = 1;
$DEBUG = $ENV{DEBUG} || 0;
use Test;
# use a BEGIN block so we print our plan before CGI::FormBuilder is loaded
BEGIN {
my $numtests = 4;
plan tests => $numtests;
# try to load template engine so absent template does
# not cause all tests to fail
eval "require Text::Template";
$SKIP = $@ ? 'skip: Text::Template not installed here' : 0;
# success if we said NOTEST
if ($ENV{NOTEST}) {
ok(1) for 1..$numtests;
exit;
}
}
# Need to fake a request or else we stall
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = 'ticket=111&user=pete&replacement=TRUE';
use CGI::FormBuilder;
# Create our template and store it in a scalarref
my $template = <<'EOT';
User Info
Please update your info and hit "Submit".
<% $jshead %>
<% $start %><% $state %>
Enter your name: <% $field{name}{field}.$field{name}{comment} %>
Select your <% $field{color}{label} %>:
<% my $ret = "$field{sex}{label} = ";
for (@{$field{sex}{options}}) {
$ret .= qq($_->[1] );
}
$ret;
%>
FYI, your dress size is <% $field{size}{value}.$field{size}{comment} %>
<% $submit %>
<% $end %>
EOT
# What options we want to use, and what we expect to see
my @test = (
{
opt => { fields => [qw/name color/],
submit => 'No esta una button del resetto',
template => { type => 'Text', TYPE => 'STRING', template => $template, },
validate => { name => 'NAME' },
},
mod => { color => { options => [qw/red green blue/],
label => 'Best Color', value => 'red' },
size => { value => 42 },
sex => { options => [[M=>'Male'],[F=>'Female']] }
},
res => q(
User Info
Please update your info and hit "Submit".
),
},
{
opt => { fields => [qw/name color size/],
template => { type => 'Text', TYPE => 'STRING', template => $template, },
values => {color => [qw/purple/], size => 8},
submit => 'Start over, boob!',
},
mod => { color => { options => [[white=>'White'],[black=>'Black'],[red=>'Green']],
label => 'Mom', },
name => { size => 80, maxlength => 80, comment => 'Fuck off' },
sex => { options => [[1=>'Yes'], [0=>'No'], [-1=>'Maybe']],
label => 'Fuck me? ' },
},
res => q(
User Info
Please update your info and hit "Submit".
),
},
{
opt => { fields => [qw/name color email/], submit => [qw/Update Delete/], reset => 0,
template => { type => 'Text', TYPE => 'STRING', template => $template, },
values => {color => [qw/yellow green orange/]},
validate => { sex => [qw(1 3 5)] },
},
mod => { color => {options => [[red => 1], [blue => 2], [yellow => 3], [pink => 4]] },
size => {comment => '(unknown)', value => undef, force => 1 } ,
sex => {label => 'glass EYE fucker', options => [[1,2],[3,4],[5,6]] },
},
res => q(
User Info
Please update your info and hit "Submit".
),
},
);
# Cycle thru and try it out
for (@test) {
my $form = CGI::FormBuilder->new(action => 'TEST', %{ $_->{opt} }, debug => $DEBUG );
while(my($f,$o) = each %{$_->{mod} || {}}) {
$o->{name} = $f;
$form->field(%$o);
}
# just compare the output of render with what's expected
my $out;
eval "\$out = \$form->render";
my $ok = skip($SKIP, $out, $_->{res});
if (! $ok && $ENV{LOGNAME} eq 'nwiger') {
open(O, ">/tmp/fb.1.out");
print O $_->{res};
close O;
open(O, ">/tmp/fb.2.out");
print O $out;
close O;
system "diff /tmp/fb.1.out /tmp/fb.2.out";
exit 1;
}
}
# MORE TESTS DOWN HERE
# from eszpee for tmpl_param
skip($SKIP, do{
my $form2 = CGI::FormBuilder->new(
template => { type => 'Text', engine => {TYPE => 'STRING', SOURCE => '<% $test %>'} }
);
$form2->tmpl_param(test => "this message should appear");
my $out;
eval "\$out = \$form2->render";
$out;
}, 'this message should appear');