#!/usr/bin/perl -I.
use strict;
use vars qw($TESTING $DEBUG);
$TESTING = 1;
$DEBUG = $ENV{DEBUG} || 0;
use Test;
# use a BEGIN block so we print our plan before CGI::FormBuilder is loaded
BEGIN { plan tests => 20 }
# Need to fake a request or else we stall
$ENV{REQUEST_METHOD} = 'GET';
$ENV{QUERY_STRING} = 'ticket=111&user=pete&replacement=TRUE&action=Unsubscribe&name=Pete+Peteson&email=pete%40peteson.com&extra=junk';
# egads this part is annoying due to line disciplines
my $h = "Content-Type: text/html; charset=ISO-8859-1\n\n";
use CGI::FormBuilder;
# What options we want to use, and what we expect to see
my @test = (
#1
{
opt => { fields => [qw/name email/], sticky => 0 },
res => q(
)
},
#2
{
opt => { fields => [qw/Upper Case/], values => { Upper => 1, Case => 0 } },
res => q(
),
},
#3
{
opt => { fields => [qw/first_name last_name/], submit => 'Update', reset => 0 },
res => q(
),
},
#4
{
opt => { fields => [qw/first_name last_name/], submit => 'Update',
reset => 0, header => 1, body => {bgcolor => 'black'} },
res => $h . q(00generate
),
},
#16
{
opt => { fields => [qw/name email/], sticky => 0 },
mod => { name => {comment => 'Hey buddy'}, email => {comment => 'No email >> address??'} },
res => q(
),
},
#17
{
opt => { fields => [qw/won too many/] },
mod => { won => { jsclick => 'taco_punch = 1'},
too => { options => [0..2], jsclick => 'this.salami.value = "delicious"'},
many => { options => [0..9], jsclick => 'this.ham.value = "it\'s a pig, man!"'},
},
res => q(
),
},
#18
{
opt => { fields => [qw/refsort/] },
mod => { refsort => { sortopts => \&refsort,
options => [qw/99 9 8 83 7 73 6 61 66 5 4 104 3 2 10 1 101/] } },
res => q(
),
},
# 19 - table attr and field columns
{
opt => { fields => [qw/a b c/],
table => { border => 1 },
td => { taco => 'beef', align => 'right' },
tr => { valign => 'top' },
th => { ignore => 'this' },
selectnum => 10,
},
mod => { a => { options => [0..3], columns => 2, value => [1..2] },
b => { options => [4..9], columns => 3, comment => "Please fill these in" },
},
res => q(
),
},
# 20 - order.cgi from manpage (big)
{
opt => { method => 'POST',
fields => [
qw(first_name last_name
email send_me_emails
address state zipcode
credit_card expiration)
],
header => 1,
title => 'Finalize Your Order',
submit => ['Place Order', 'Cancel'],
reset => 0,
validate => {
email => 'EMAIL',
zipcode => 'ZIPCODE',
credit_card => 'CARD',
expiration => 'MMYY',
},
required => 'ALL',
jsfunc => < { state => {
options => [qw(JS IW KS UW JS UR EE DJ HI YK NK TY)],
sortopts=> 'NAME'
},
send_me_emails => {
options => [[1 => 'Yes'], [0 => 'No']],
value => 0, # "No"
},
},
res => $h . q(Finalize Your Order
Finalize Your Order
Fields that are highlighted are required.
),
},
);
sub refsort {
$_[0] <=> $_[1]
}
# Perl is sick.
@test = @test[$ARGV[0] - 1] if @ARGV;
# Cycle thru and try it out
for (@test) {
my $form = CGI::FormBuilder->new( %{ $_->{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 $ok = ok($form->render, $_->{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 $form->render;
close O;
system "diff /tmp/fb.1.out /tmp/fb.2.out";
exit 1;
}
}