The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $ok = 0; $| = 1; $total = 30; print "1..$total\n"; }
END {print "not ok 1\n" unless $ok;}
use CGI::Validate qw(:all);

print "Testing CGI::Validate " . CGI::Validate->VERSION . "\n";
my $printf = '%-22s';
printf $printf, 'load';
print "ok 1\n"; $ok++;

@ARGV = qw(
	StringValid=ValidString StringBlank=
	WordValid=ValidWord		WordInvalid=@$	WordBlank=
	IntegerValid=123		IntegerInvalid1=foo
	IntegerInvalid2=12.2	IntegerBlank=
	FloatValid=12.3			FloatInvalid1=foo
	FloatInvalid2=12.2.		FloatBlank=
	EmailValid=foo@bar.com	EmailInvalid=@bar.com
	EmailBlank=
	ExtensionOneValid=foo:bar	ExtensionOneInvalid=foobar
	ExtensionOneBlank=
	ExtensionTwoValid=foo:bar
	InvalidField1=foo		InvalidField2=
	MultipleString=foo		MultipleString=bar
	MultipleString=cat		MultipleString=dog
);

addExtensions (
	ExtensionOne	=> sub {shift =~ /:/ },
	ExtensionTwo	=> sub {
		if ($_[0] =~ /:/) {
			$_[0] = 'TEST';
			return 1;
		} else {
			return 0;
		}
	},
);

my %Values = ();

$Values{MultipleString} = [];

my $Query = GetFormData (
	'StringValid=s'		=> \$Values{StringValid},
	'StringBlank=s'		=> \$Values{StringBlank},
	'WordValid=w'		=> \$Values{WordValid},
	'WordBlank=w'		=> \$Values{WordBlank},
	'WordInvalid=w'		=> \$Values{WordInalid},
	'IntegerValid=i'	=> \$Values{IntegerValid},
	'IntegerInvalid1=i'	=> \$Values{IntegerInvalid1},
	'IntegerInvalid2=i'	=> \$Values{IntegerInvalid2},
	'IntegerBlank=i'	=> \$Values{IntegerBlank},
	'FloatValid=f'		=> \$Values{FloatValid},
	'FloatInvalid1=f'	=> \$Values{FloatInalid1},
	'FloatInvalid2=f'	=> \$Values{FloatInalid2},
	'FloatBlank=f'		=> \$Values{FloatBlank},
	'EmailValid=e'		=> \$Values{EmailValid},
	'EmailInvalid=e'	=> \$Values{EmailInvalid},
	'EmailBlank=e'		=> \$Values{EmailBlank},
	'ExtensionOneValid=xExtensionOne'	=> \$Values{ExtensionOneValid},
	'ExtensionOneInvalid=xExtensionOne'	=> \$Values{ExtensionOneInvalid},
	'ExtensionOneBlank=xExtensionOne'	=> \$Values{ExtensionOneBlank},
	'ExtensionTwoValid=xExtensionTwo'	=> \$Values{ExtensionTwoValid},
	'MultipleString=s'	=> $Values{MultipleString},
	'MissingOne=s'		=> \$Values{MissingOne},
);

printf $printf, 'base';
if ($query) {
	print "not ok 2\n";
} else {
	print "ok 2\n"; $ok++;
}

printf $printf, 'invalid field one';
if ($Invalid{InvalidField1}) {
	print "ok 3\n"; $ok++
} else {
	print "not ok 3\n";
}
delete $Invalid{InvalidField1};

printf $printf, 'invalid field two';
if ($Invalid{InvalidField2}) {
	print "ok 4\n"; $ok++;
} else {
	print "not ok 4\n";
}
delete $Invalid{InvalidField2};

printf $printf, 'blank email';
if ($Blank{EmailBlank}) {
	print "ok 5\n"; $ok++;
} else {
	print "not ok 5\n";
}
delete $Blank{EmailBlank};

printf $printf, 'blank word';
if ($Blank{WordBlank}) {
	print "ok 6\n"; $ok++;
} else {
	print "not ok 6\n";
}
delete $Blank{WordBlank};

printf $printf, 'blank float';
if ($Blank{FloatBlank}) {
	print "ok 7\n"; $ok++;
} else {
	print "not ok 7\n";
}
delete $Blank{FloatBlank};

printf $printf, 'blank integer';
if ($Blank{IntegerBlank}) {
	print "ok 8\n"; $ok++;
} else {
	print "not ok 8\n";
}
delete $Blank{IntegerBlank};

printf $printf, 'blank extension';
if ($Blank{ExtensionOneBlank}) {
	print "ok 9\n"; $ok++;
} else {
	print "not ok 9\n";
}
delete $Blank{ExtensionOneBlank};

printf $printf, 'blank string';
if ($Blank{StringBlank}) {
	print "ok 10\n"; $ok++;
} else {
	print "not ok 10\n";
}
delete $Blank{StringBlank};

printf $printf, 'invalid blanks';
unless (%Blank) {
	print "ok 11\n"; $ok++;
} else {
	print "not ok 11\n";
}

printf $printf, 'invalid word';
if ($InvalidType{WordInvalid}) {
	print "ok 12\n"; $ok++;
} else {
	print "not ok 12\n";
}
delete $InvalidType{WordInvalid};

printf $printf, 'invalid extension';
if ($InvalidType{ExtensionOneInvalid}) {
	print "ok 13\n"; $ok++;
} else {
	print "not ok 13\n";
}
delete $InvalidType{ExtensionOneInvalid};

printf $printf, 'invalid float one';
if ($InvalidType{FloatInvalid1}) {
	print "ok 14\n"; $ok++;
} else {
	print "not ok 14\n";
}
delete $InvalidType{FloatInvalid1};

printf $printf, 'invalid integer one';
if ($InvalidType{IntegerInvalid1}) {
	print "ok 15\n"; $ok++;
} else {
	print "not ok 15\n";
}
delete $InvalidType{IntegerInvalid1};

printf $printf, 'invalid email';
if ($InvalidType{EmailInvalid}) {
	print "ok 16\n"; $ok++;
} else {
	print "not ok 16\n";
}
delete $InvalidType{EmailInvalid};

printf $printf, 'invalid float two';
if ($InvalidType{FloatInvalid2}) {
	print "ok 17\n"; $ok++;
} else {
	print "not ok 17\n";
}
delete $InvalidType{FloatInvalid2};

printf $printf, 'invalid integer two';
if ($InvalidType{IntegerInvalid2}) {
	print "ok 18\n"; $ok++;
} else {
	print "not ok 18\n";
}
delete $InvalidType{IntegerInvalid2};

printf $printf, 'invalid invalid-type';
unless (%InvalidType) {
	print "ok 19\n"; $ok++;
} else {
	print "not ok 19\n";
}

printf $printf, 'invalid invalids';
unless (%Invalid) {
	print "ok 20\n"; $ok++;
} else {
	print "not ok 20\n";
}

printf $printf, 'missing one';
if ($Missing{MissingOne}) {
	print "ok 21\n"; $ok++;
} else {
	print "not ok 21\n";
}
delete $Missing{MissingOne};

printf $printf, 'invalid missing';
unless (%Missing) {
	print "ok 22\n"; $ok++;
} else {
	print "not ok 22\n";
}

printf $printf, 'valid string';
if ($Values{StringValid} eq 'ValidString') {
	print "ok 23\n"; $ok++;
} else {
	print "not ok 23\n";
}

printf $printf, 'valid word';
if ($Values{WordValid} eq 'ValidWord') {
	print "ok 24\n"; $ok++;
} else {
	print "not ok 24\n";
}

printf $printf, 'valid integer';
if ($Values{IntegerValid} == 123) {
	print "ok 25\n"; $ok++;
} else {
	print "not ok 25\n";
}

printf $printf, 'valid float';
if ($Values{FloatValid} == 12.3) {
	print "ok 26\n"; $ok++;
} else {
	print "not ok 26\n";
}

printf $printf, 'valid email';
if ($Values{EmailValid} eq 'foo@bar.com') {
	print "ok 27\n"; $ok++;
} else {
	print "not ok 27\n";
}

printf $printf, 'valid extension';
if ($Values{ExtensionOneValid} eq 'foo:bar') {
	print "ok 28\n"; $ok++;
} else {
	print "not ok 28\n";
}

printf $printf, 'modified extension';
if ($Values{ExtensionTwoValid} eq 'TEST') {
	print "ok 29\n"; $ok++;
} else {
	print "not ok 29\n";
}

printf $printf, 'multiple select';
if (scalar @{ $Values{MultipleString} } == 4) {
	print "ok 30\n"; $ok++;
} else {
	print "not ok 30\n";
}

if ($ok != $total) {
	$failed = $total - $ok;
	$CGI::Validate::Error =~ s/^/\t/gm;
	die "Failed $failed out of $total tests:\n$CGI::Validate::Error\n";
} else {
	print "Passed all $total tests\n";
}