# 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";
}