#!/usr/bin/perl use strict; use vars qw($TESTING); $TESTING = 1; use Test; # use a BEGIN block so we print our plan before CGI::FormBuilder is loaded BEGIN { plan tests => 10 } # Need to fake a request or else we stall $ENV{REQUEST_METHOD} = 'GET'; $ENV{QUERY_STRING} = 'ticket=111&user=pete&replacement=TRUE'; # egads this part is annoying use CGI 'header'; my $h = header(); use CGI::FormBuilder; # What options we want to use, and what we expect to see my @test = ( { opt => { fields => [qw/name email/] }, res => q(
Name
Email
) }, { opt => { fields => [qw/Upper Case/], values => { Upper => 1, Case => 0 } }, res => q(
Upper
Case
), }, { opt => { fields => [qw/first_name last_name/], submit => 'Update', reset => 0 }, res => q(
First Name
Last Name
), }, { opt => { fields => [qw/first_name last_name/], submit => 'Update', reset => 0, header => 1, body => {bgcolor => 'black'} }, res => $h . q(00generate

00generate

First Name
Last Name
), }, { opt => { fields => {first_name => 'Nate', email => 'nate@wiger.org' }, validate => {email => 'EMAIL'}, required => [qw/first_name/] }, res => q(

Fields shown in bold are required.

Email (name@host.domain)
First Name
), }, { # utilize our query_string to test stickiness opt => { fields => [qw/ticket user part_number/], method => 'POST', keepextras => 1, validate => { ticket => '/^\d+$/' }, submit => [qw/Update Delete Cancel/], }, res => q(

Fields shown in bold are required.

Ticket
User
Part Number
), }, { # max it out, baby opt => { fields => [qw/supply demand/], options => { supply => [0..9], demand => [0..9] }, values => { supply => [0..4], demand => [5..9] }, method => 'PUT', title => 'Econ 101', action => '/nowhere.cgi', header => 1, name => 'econ', font => 'arial,helvetica', fieldtype => 'select' }, res => $h . q(Econ 101

Econ 101

Supply
Demand
), }, { opt => { fields => [qw/db:name db:type db:tab ux:user ux:name/], static => 1 }, res => q(
Db Name
Db Type
Db Tab
Ux User
Ux Name
), }, { # single-line search thing ala Yahoo! opt => { fields => 'search', submit => 'Go', reset => 0 }, res => q(
Search
), }, { opt => { fields => [qw/hostname domain/], header => 1, keepextras => 1, values => [qw/localhost localdomain/], validate => {hostname => 'HOST', domain => 'DOMAIN'}, }, res => $h . q(00generate

00generate

Fields shown in bold are required.

Hostname (valid hostname)
Domain (DNS domain)
), }, ); # Cycle thru and try it out for (@test) { my $form = CGI::FormBuilder->new( %{ $_->{opt} } ); while(my($f,$o) = each %{$_->{mod} || {}}) { $o->{name} = $f; $form->field(%$o); } # just compare the output of render with what's expected ok($form->render, $_->{res}); if ($ENV{LOGNAME} eq 'nwiger') { open(O, ">/tmp/fb.1.out"); print O $form->render; close O; open(O, ">/tmp/fb.2.out"); print O $_->{res}; close O; system "diff /tmp/fb.1.out /tmp/fb.2.out"; exit if $?; } }