r1336 -
packages/libdata-formvalidator-perl/branches/upstream/current/t
Gunnar Wolf
gwolf at costa.debian.org
Tue Sep 6 20:48:59 UTC 2005
Author: gwolf
Date: 2005-09-06 20:48:58 +0000 (Tue, 06 Sep 2005)
New Revision: 1336
Added:
packages/libdata-formvalidator-perl/branches/upstream/current/t/dates.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/missing_optional.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/msgs.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/pod.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/profile_checking.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/regexp_common.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/simple.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/untaint.pl
packages/libdata-formvalidator-perl/branches/upstream/current/t/untaint.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/upload.t
Removed:
packages/libdata-formvalidator-perl/branches/upstream/current/t/01_simple.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/07_missing_optional.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/08_profile_checking.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/12_untaint.pl
packages/libdata-formvalidator-perl/branches/upstream/current/t/12_untaint.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/22_msgs.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/23_dates.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/24_upload.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/29_regexp_common.t
packages/libdata-formvalidator-perl/branches/upstream/current/t/99_pod.t
Log:
To prepare to load /tmp/tmp.lp0E0f/libdata-formvalidator-perl-4.02 into
packages/libdata-formvalidator-perl/branches/upstream/current, perform
10 renames.
*
packages/libdata-formvalidator-perl/branches/upstream/current/t/simpl
e.t: Renamed from
packages/libdata-formvalidator-perl/branches/upstream/current/t/01_si
mple.t.
*
packages/libdata-formvalidator-perl/branches/upstream/current/t/pod.t
: Renamed from
packages/libdata-formvalidator-perl/branches/upstream/current/t/99_po
d.t.
*
packages/libdata-formvalidator-perl/branches/upstream/current/t/untai
nt.pl: Renamed from
packages/libdata-formvalidator-perl/branches/upstream/current/t/12_un
taint.pl.
*
packages/libdata-formvalidator-perl/branches/upstream/current/t/untai
nt.t: Renamed from
packages/libdata-formvalidator-perl/branches/upstream/current/t/12_un
taint.t.
*
packages/libdata-formvalidator-perl/branches/upstream/current/t/uploa
d.t: Renamed from
packages/libdata-formvalidator-perl/branches/upstream/current/t/24_up
load.t.
*
packages/libdata-formvalidator-perl/branches/upstream/current/t/profi
le_checking.t: Renamed from
packages/libdata-formvalidator-perl/branches/upstream/current/t/08_pr
ofile_checking.t.
*
packages/libdata-formvalidator-perl/branches/upstream/current/t/regex
p_common.t: Renamed from
packages/libdata-formvalidator-perl/branches/upstream/current/t/29_re
gexp_common.t.
*
packages/libdata-formvalidator-perl/branches/upstream/current/t/dates
.t: Renamed from
packages/libdata-formvalidator-perl/branches/upstream/current/t/23_da
tes.t.
*
packages/libdata-formvalidator-perl/branches/upstream/current/t/msgs.
t: Renamed from
packages/libdata-formvalidator-perl/branches/upstream/current/t/22_ms
gs.t.
*
packages/libdata-formvalidator-perl/branches/upstream/current/t/missi
ng_optional.t: Renamed from
packages/libdata-formvalidator-perl/branches/upstream/current/t/07_mi
ssing_optional.t.
Deleted: packages/libdata-formvalidator-perl/branches/upstream/current/t/01_simple.t
===================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/01_simple.t 2005-09-01 23:29:39 UTC (rev 1335)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/01_simple.t 2005-09-06 20:48:58 UTC (rev 1336)
@@ -1,36 +0,0 @@
-
-use strict;
-
-$^W = 1;
-
-use Test::More tests => 3;
-
-use Data::FormValidator;
-
-my $input_profile = {
- required => [ qw( email phone likes ) ],
- optional => [ qq( toppings ) ],
- constraints => {
- email => "email",
- phone => "phone",
- }
- };
-
-my $validator = new Data::FormValidator({default => $input_profile});
-
-my $input_hashref = {email => 'invalidemail',
- phone => '201-999-9999',
- likes => ['a','b'],
- toppings => 'foo'};
-
-my ($valids, $missings, $invalids, $unknowns) = ({},[],[],[]);
-
-eval{
- ($valids, $missings, $invalids, $unknowns) = $validator->validate($input_hashref, 'default');
-};
-ok(not $@) or
- diag $@;
-
-ok(exists $valids->{'phone'});
-
-is($invalids->[0], 'email');
Deleted: packages/libdata-formvalidator-perl/branches/upstream/current/t/07_missing_optional.t
===================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/07_missing_optional.t 2005-09-01 23:29:39 UTC (rev 1335)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/07_missing_optional.t 2005-09-06 20:48:58 UTC (rev 1336)
@@ -1,65 +0,0 @@
-use Test::More tests => 6;
-use strict;
-
-$^W = 1;
-
-use Data::FormValidator;
-
-my $input_profile = {
- required => [ qw( email_1 email_ok) ],
- optional => ['filled','not_filled'],
- constraint_regexp_map => {
- '/^email/' => "email",
- },
- constraints => {
- not_filled => 'phone',
- },
- missing_optional_valid => 1,
- };
-
-my $validator = new Data::FormValidator({default => $input_profile});
-
-my $input_hashref = {
- email_1 => 'invalidemail',
- email_ok => 'mark at stosberg.com',
- filled => 'dog',
- not_filled => '',
- should_be_unknown => 1,
-};
-
-my ($valids, $missings, $invalids, $unknowns);
-
-eval{
- ($valids, $missings, $invalids, $unknowns) = $validator->validate($input_hashref, 'default');
-};
-ok (not $@);
-
-# "not_filled" should appear valids now.
-ok (exists $valids->{'not_filled'});
-
-
-# "should_be_unknown" should be still be unknown
-ok($unknowns->[0] eq 'should_be_unknown');
-
-eval {
- require CGI;
-};
-SKIP: {
- skip 'CGI.pm not found', 3 if $@;
-
- my $q = new CGI($input_hashref);
- my ($valids, $missings, $invalids, $unknowns);
- eval{
- ($valids, $missings, $invalids, $unknowns) = $validator->validate($q, 'default');
- };
-
- ok (not $@);
-
- # "not_filled" should appear valids now.
- ok (exists $valids->{'not_filled'});
-
- # "should_be_unknown" should be still be unknown
- ok($unknowns->[0] eq 'should_be_unknown');
-
-};
-
Deleted: packages/libdata-formvalidator-perl/branches/upstream/current/t/08_profile_checking.t
===================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/08_profile_checking.t 2005-09-01 23:29:39 UTC (rev 1335)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/08_profile_checking.t 2005-09-06 20:48:58 UTC (rev 1336)
@@ -1,48 +0,0 @@
-
-use strict;
-
-$^W = 1;
-
-use Test::More tests => 1;
-
-use Data::FormValidator;
-
-my $input_profile = {
- required => [ qw( email_1 email_ok) ],
- optional => ['filled','not_filled'],
- constraint_regexp_map => {
- '/^email/' => "email",
- },
- constraints => {
- not_filled => 'phone',
- },
- missing_optional_valid => 1,
- bad_key_which_should_trigger_error=>1,
- another_bad_key_which_should_trigger_error=>1,
- };
-
-my $validator = new Data::FormValidator({default => $input_profile});
-
-my $input_hashref = {
- email_1 => 'invalidemail',
- email_ok => 'mark at stosberg.com',
- filled => 'dog',
- not_filled => '',
- should_be_unknown => 1,
-};
-
-my ($valids, $missings, $invalids, $unknowns);
-
-eval{
- ($valids, $missings, $invalids, $unknowns) = $validator->validate($input_hashref, 'default');
-};
-#use Data::Dumper; warn Dumper ($valids, $missings, $invalids, $unknowns);
-
-ok(not $@
- or
- $@ eq "Invalid input profile: keys not recognised [bad_key_which_should_trigger_error, another_bad_key_which_should_trigger_error]\n"
- or
- $@ eq "Invalid input profile: keys not recognised [another_bad_key_which_should_trigger_error, bad_key_which_should_trigger_error]\n"
- );
-
-
Deleted: packages/libdata-formvalidator-perl/branches/upstream/current/t/12_untaint.pl
===================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/12_untaint.pl 2005-09-01 23:29:39 UTC (rev 1335)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/12_untaint.pl 2005-09-06 20:48:58 UTC (rev 1336)
@@ -1,146 +0,0 @@
-#!/usr/bin/perl -wT
-
-use strict;
-
-use Test::More tests => 28;
-use Data::FormValidator;
-
-$ENV{PATH} = "/bin/";
-
-sub is_tainted {
- my $val = shift;
- return !eval { $val++, kill 0; 1; };
-}
-
-my $data1 = {
- firstname => $ARGV[0], #Jim
-};
-
-my $data2 = {
- lastname => $ARGV[1], #Beam
- email1 => $ARGV[2], #jim at foo.bar
- email2 => $ARGV[3], #james at bar.foo
-};
-
-my $data3 = {
- ip_address => $ARGV[4], #132.10.10.2
- cats_name => $ARGV[5], #Monroe
- dogs_name => $ARGV[6], #Rufus
-};
-
-my $data4 = {
- zip_field1 => [$ARGV[7],$ARGV[7]], #12345 , 12345
- zip_field2 => [$ARGV[7],$ARGV[8]], #12345 , oops
-};
-
-
-my $profile =
-{
- rules1 => {
- untaint_constraint_fields => "firstname",
- required => "firstname",
- constraints => {
- firstname => '/^\w{1,15}$/'
- },
- },
- rules2 => {
- untaint_constraint_fields => [ qw( lastname email1 )],
- required =>
- [ qw( lastname email1 email2) ],
- constraints => {
- lastname => '/^\w{1,10}$/',
- email1 => "email",
- email2 => "email",
- }
- },
- rules3 => {
- untaint_all_constraints => 1,
- required =>
- [ qw(ip_address cats_name dogs_name) ],
- constraints => {
- ip_address => "ip_address",
- cats_name => '/^Felix$/',
- dogs_name => 'm/^rufus$/i',
- }
- },
- rules4 => {
- untaint_constraint_fields=> ['zip_field1','zip_field2'],
- required=>[qw/zip_field1 zip_field2/],
- constraints=> {
- zip_field1=>'zip',
- },
- },
-};
-
-my $validator = new Data::FormValidator($profile);
-
-#Rules #1
-my ( $valid, $missing, $invalid, $unknown );
-eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data1, "rules1"); };
-
-ok(!$@,'avoided eval error');
-ok($valid->{firstname}, 'found firstname');
-ok(! is_tainted($valid->{firstname}), 'firstname is untainted');
-is($valid->{firstname},$data1->{firstname}, 'firstname has expected value');
-
-#Rules #2
-eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data2, "rules2"); };
-
-ok(!$@,'avoided eval error');
-ok($valid->{lastname});
-ok(!is_tainted($valid->{lastname}));
-is($valid->{lastname},$data2->{lastname});
-
-ok($valid->{email1});
-ok(!is_tainted($valid->{email1}));
-is($valid->{email1},$data2->{email1});
-
-ok($valid->{email2});
-ok(is_tainted($valid->{email2}), 'email2 is tainted');
-is($valid->{email2},$data2->{email2});
-
-#Rules #3
-eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data3, "rules3"); };
-
-ok(!$@);
-
-ok($valid->{ip_address});
-ok(!is_tainted($valid->{ip_address}));
-is($valid->{ip_address},$data3->{ip_address});
-
-#in this case we're expecting no match
-ok(!(exists $valid->{cats_name}), 'cats_name is not valid');
-is($invalid->[0], 'cats_name', 'cats_name fails constraint');
-
-ok($valid->{dogs_name});
-ok(!is_tainted($valid->{dogs_name}));
-is($valid->{dogs_name},$data3->{dogs_name});
-
-# Rules # 4
-eval { ( $valid, $missing, $invalid, $unknown ) = $validator->validate( $data4, "rules4"); };
-ok(!$@, 'avoided eval error');
-
-ok(!is_tainted($valid->{zip_field1}->[0]),
- 'zip_field1 should be untainted');
-
-ok(is_tainted($valid->{zip_field2}->[0]),
- 'zip_field2 should be tainted');
-
-
-my $results = Data::FormValidator->check(
- {
- qr_re_no_parens => $ARGV[9], # 0
- qr_re_parens => $ARGV[9], # 0
-
- },
- {
- required => [qw/qr_re_no_parens qr_re_parens/],
- constraints=>{
- qr_re_no_parens => qr/^.*$/,
- qr_re_parens => qr/^(.*)$/,
- },
- untaint_all_constraints =>1
- });
-
-is($results->valid('qr_re_no_parens'),0,'qr RE without parens in untainted');
-is($results->valid('qr_re_parens') ,0,'qr RE with parens in untainted');
Deleted: packages/libdata-formvalidator-perl/branches/upstream/current/t/12_untaint.t
===================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/12_untaint.t 2005-09-01 23:29:39 UTC (rev 1335)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/12_untaint.t 2005-09-06 20:48:58 UTC (rev 1336)
@@ -1,2 +0,0 @@
-# We use $^X to make it easier to test with different versions of Perl. -mls
-system($^X.' -Iblib/lib -T ./t/12_untaint.pl Jim Beam jim at foo.bar james at bar.foo 132.10.10.2 Monroe Rufus 12345 oops 0');
Deleted: packages/libdata-formvalidator-perl/branches/upstream/current/t/22_msgs.t
===================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/22_msgs.t 2005-09-01 23:29:39 UTC (rev 1335)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/22_msgs.t 2005-09-06 20:48:58 UTC (rev 1336)
@@ -1,180 +0,0 @@
-use Test::More tests => 14;
-use strict;
-
-use Data::FormValidator;
-
-my $simple_profile = {
- required => [qw/req_1 req_2/],
- optional => [qw/opt_1/],
- constraints => {
- req_1 => 'email'
- },
- msgs=>{},
-};
-
-my $simple_data = {
- req_1 => 'not_an_email',
-};
-
-my $prefix_profile = {
- required => [qw/req_1 req_2/],
- optional => [qw/opt_1/],
- constraints => {
- req_1 => 'email'
- },
- msgs=>{
- prefix=>'',
- any_errors=>'err__',
- },
-};
-
-my $input_profile = {
- required => [ qw(admin prefork sleep rounds) ],
- constraints => {
- admin => "email",
- prefork => sub {
- my $val = shift;
- if ($val =~ /^\d$/) {
- if ($val > 1 and $val <9) {
- return $val;
- }
- }
- return 0;
- },
- sleep => [
- 'email',
- {
- name => 'min',
- constraint => sub {
- my $val = shift;
- if ($val > 0) {
- return $val;
- } else {
- return 0;
- }
- }
- },
- {
- name => 'max',
- constraint => sub {
- my $val = shift;
- if ($val < 11) {
- return $val;
- } else {
- return 0;
- }
- }
- }
- ],
- rounds => [
- {
- name => 'min',
- constraint => sub {
- my $val = shift;
- if ($val > 19) {
- return $val;
- } else {
- return 0;
- }
- }
- },
- {
- name => 'max',
- constraint => sub {
- my $val = shift;
- if ($val < 101) {
- return $val;
- } else {
- return 0;
- }
- }
- }
- ]
- },
- msgs => {
- missing => 'Test-Missing',
- invalid => 'Test-Invalid',
- invalid_seperator=> ' ## ',
-
- constraints => {
- max => 'needs to be lesser than 11',
- min => 'needs to be greater than 0'
- },
- format => 'ERROR: %s',
- prefix => 'error_',
- }
- };
-
-my $validator = new Data::FormValidator({
- simple => $simple_profile,
- default => $input_profile,
- prefix => $prefix_profile,
- });
-
-my $input_hashref = {admin=> 'invalidemail', prefork=> 9, sleep => 11, rounds=>8};
-
-my $results;
-eval{
- $results = $validator->check($simple_data, 'simple');
-};
-ok (not $@);
-
-TODO: {
- local $TODO= 'need to test for msgs() called before validate';
- # msgs() should return emit a warning and return undef if the hash
- # structure it points to is undefined. However, if it points to an
- # empty hash, then maybe there are just no messages.
-};
-
-# testing simple msg definition, $self->msgs should be returned as a hash ref
-my $msgs;
-eval {
- $msgs = $results->msgs;
-};
-ok((not $@), 'existence of msgs method' ) or
- diag $@;
-
-
-ok (ref $msgs eq 'HASH', 'invalid fields returned as hash in simple case');
-
-
-like ($msgs->{req_1}, qr/Invalid/, 'default invalid message');
-like ($msgs->{req_2}, qr/Missing/, 'default missing message');
-like ($msgs->{req_1}, qr/span/, 'default formatting');
-
-
-# testing single constraints and single error case
-eval{
- $results = $validator->check($input_hashref, 'default');
-};
-ok (not $@);
-$msgs = $results->msgs;
-
-like($msgs->{error_sleep} ,qr/lesser.*Test|Test.*lesser/, 'multiple constraints constraint definition');
-
-eval{
- $results = $validator->check($simple_data, 'prefix');
-};
-ok (not $@) or
- diag $@;
-
-$msgs = $results->msgs({format => 'Control-Test: %s'});
-
-ok(defined $msgs->{req_1}, 'using default prefix');
-is(keys %$msgs, 3, 'size of msgs hash'); # 2 errors plus 1 prefix
-ok(defined $msgs->{err__}, 'any_errors');
-like($msgs->{req_1},qr/Control/,'passing controls to method');
-
-# See what happens when msgs is called with it does not appeare in the profile
-my @basic_input = (
- {
- field_1 => 'email',
- },
- {
- required => 'field_1',
-
- });
-$results = Data::FormValidator->check(@basic_input);
-eval { $results->msgs };
-ok ((not $@), 'calling msgs method without hash definition');
-
Deleted: packages/libdata-formvalidator-perl/branches/upstream/current/t/23_dates.t
===================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/23_dates.t 2005-09-01 23:29:39 UTC (rev 1335)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/23_dates.t 2005-09-06 20:48:58 UTC (rev 1336)
@@ -1,65 +0,0 @@
-#!/usr/bin/perl -w
-use Test::More qw/no_plan/;
-BEGIN { use_ok('Data::FormValidator::Constraints::Dates') };
-use strict;
-
-my $format = Data::FormValidator::Constraints::Dates::_prepare_date_format('MM/DD/YYYY hh?:mm:ss pp');
-
-my ($date,$year, $month, $day, $hour, $min, $sec) = Data::FormValidator::Constraints::Dates::_parse_date_format($format, '12/02/2003 1:01:03 PM');
-ok ($date eq '12/02/2003 1:01:03 PM','returning untainted date');
-ok ($year == 2003, 'basic date prepare and parse test');
-ok ($month == 12);
-ok ($day == 2);
-ok ($hour == 13);
-ok ($min == 1);
-ok ($sec == 3);
-
-# Now try again, leaving out PM, which may trigger a warning when it shouldn't
-$format = Data::FormValidator::Constraints::Dates::_prepare_date_format('MM/DD/YYYY hh?:mm:ss');
-($date,$year, $month, $day, $hour, $min, $sec) = Data::FormValidator::Constraints::Dates::_parse_date_format($format, '12/02/2003 1:01:03');
-is($date,'12/02/2003 1:01:03','returning untainted date');
-ok ($year == 2003, 'basic date prepare and parse test');
-ok ($month == 12, 'month');
-ok ($day == 2,'day');
-ok ($hour == 1,'hour');
-ok ($min == 1,'min');
-ok ($sec == 3,'sec');
-
-use Data::FormValidator;
-
-my $simple_profile = {
- required => [qw/date_and_time_field_bad date_and_time_field_good/],
- validator_packages => [qw/Data::FormValidator::Constraints::Dates/],
- constraints => {
- 'date_and_time_field_good' => {
- constraint_method => 'date_and_time',
- params=>[\'MM/DD/YYYY hh:mm pp'],
- },
- 'date_and_time_field_bad' => {
- constraint_method => 'date_and_time',
- params=>[\'MM/DD/YYYY hh:mm pp'],
- },
- },
- untaint_constraint_fields=>[qw/date_and_time_field/],
-};
-
-my $simple_data = {
- date_and_time_field_good => '12/04/2003 02:00 PM',
- date_and_time_field_bad => 'slug',
-};
-
-
-my $validator = new Data::FormValidator({
- simple => $simple_profile,
- });
-
-my ($valids, $missings, $invalids, $unknowns) = ({},[],{},[]);
-eval{
- ($valids, $missings, $invalids, $unknowns) = $validator->validate($simple_data, 'simple');
-};
-ok ((not $@), 'eval') or
- diag $@;
-ok ($valids->{date_and_time_field_good}, 'expecting date_and_time success');
-ok ((grep /date_and_time_field_bad/, @$invalids), 'expecting date_and_time failure');
-
-
Deleted: packages/libdata-formvalidator-perl/branches/upstream/current/t/24_upload.t
===================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/24_upload.t 2005-09-01 23:29:39 UTC (rev 1335)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/24_upload.t 2005-09-06 20:48:58 UTC (rev 1336)
@@ -1,167 +0,0 @@
-#########################
-
-use Test::More tests => 18;
-use strict;
-BEGIN {
- use_ok('CGI');
- use_ok('Data::FormValidator::Constraints::Upload')
-};
-
-#########################
-
-%ENV = (
- %ENV,
- 'SCRIPT_NAME' => '/test.cgi',
- 'SERVER_NAME' => 'perl.org',
- 'HTTP_CONNECTION' => 'TE, close',
- 'REQUEST_METHOD' => 'POST',
- 'SCRIPT_URI' => 'http://www.perl.org/test.cgi',
- 'CONTENT_LENGTH' => 3129,
- 'SCRIPT_FILENAME' => '/home/usr/test.cgi',
- 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
- 'HTTP_TE' => 'deflate,gzip;q=0.3',
- 'QUERY_STRING' => '',
- 'REMOTE_PORT' => '1855',
- 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)',
- 'SERVER_PORT' => '80',
- 'REMOTE_ADDR' => '127.0.0.1',
- 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
- 'SERVER_PROTOCOL' => 'HTTP/1.1',
- 'PATH' => '/usr/local/bin:/usr/bin:/bin',
- 'REQUEST_URI' => '/test.cgi',
- 'GATEWAY_INTERFACE' => 'CGI/1.1',
- 'SCRIPT_URL' => '/test.cgi',
- 'SERVER_ADDR' => '127.0.0.1',
- 'DOCUMENT_ROOT' => '/home/develop',
- 'HTTP_HOST' => 'www.perl.org'
-);
-
-diag "testing with CGI.pm version: $CGI::VERSION";
-
-open(IN,'<t/upload_post_text.txt') || die 'missing test file';
-binmode(IN);
-
-*STDIN = *IN;
-my $q = new CGI;
-
-use Data::FormValidator;
-my $default = {
- required=>[qw/hello_world does_not_exist_gif 100x100_gif 300x300_gif/],
- validator_packages=> 'Data::FormValidator::Constraints::Upload',
- constraints => {
- 'hello_world' => {
- constraint_method => 'file_format',
- params=>[],
- },
- 'does_not_exist_gif' => {
- constraint_method => 'file_format',
- params=>[],
- },
- '100x100_gif' => [
- {
- constraint_method => 'file_format',
- params=>[],
- },
- {
- constraint_method => 'file_max_bytes',
- params=>[],
- }
- ],
- '300x300_gif' => {
- constraint_method => 'file_max_bytes',
- params => [\100],
- },
- },
- };
-
-my $dfv = Data::FormValidator->new({ default => $default});
-my ($results);
-eval {
- $results = $dfv->check($q, 'default');
-};
-ok(not $@) or diag $@;
-
-my $valid = $results->valid;
-my $invalid = $results->invalid; # as hash ref
-my @invalids = $results->invalid;
-my $missing = $results->missing;
-
-
-# Test to make sure hello world fails because it is the wrong type
-ok((grep {m/hello_world/} @invalids), 'expect format failure');
-
-# should fail on empty/missing source file data
-ok((grep {m/does_not_exist_gif/} @invalids), 'expect non-existent failure');
-
-
-# Make sure 100x100 passes because it is the right type and size
-ok(exists $valid->{'100x100_gif'});
-
-my $meta = $results->meta('100x100_gif');
-is(ref $meta, 'HASH', 'meta() returns hash ref');
-
-ok($meta->{extension}, 'setting extension meta data');
-ok($meta->{mime_type}, 'setting mime_type meta data');
-
-# 300x300 should fail because it is too big
-ok((grep {m/300x300/} @invalids), 'max_bytes');
-
-ok($results->meta('100x100_gif')->{bytes}>0, 'setting bytes meta data');
-
-
-# Revalidate to usefully re-use the same fields
-my $profile_2 = {
- required=>[qw/hello_world 100x100_gif 300x300_gif/],
- validator_packages=> 'Data::FormValidator::Constraints::Upload',
- constraints => {
- '100x100_gif' => {
- constraint_method => 'image_max_dimensions',
- params => [\200,\200],
- },
- '300x300_gif' => {
- constraint_method => 'image_max_dimensions',
- params => [\200,\200],
- },
- },
-};
-
-$dfv = Data::FormValidator->new({ profile_2 => $profile_2});
-eval {
- $results = $dfv->check($q, 'profile_2');
-};
-ok(not $@) or diag $@;
-
-$valid = $results->valid;
-$invalid = $results->invalid; # as hash ref
- at invalids = $results->invalid;
-$missing = $results->missing;
-
-ok(exists $valid->{'100x100_gif'}, 'expecting success with max_dimensions');
-ok((grep /300x300/, @invalids), 'expecting failure with max_dimensions');
-
-ok( $results->meta('100x100_gif')->{width} > 0, 'setting width as meta data');
-ok( $results->meta('100x100_gif')->{width} > 0, 'setting height as meta data');
-
-# Now test trying constraint_regxep_map
-my $profile_3 = {
- required=>[qw/hello_world 100x100_gif 300x300_gif/],
- validator_packages=> 'Data::FormValidator::Constraints::Upload',
- constraint_regexp_map => {
- '/[13]00x[13]00_gif/' => {
- constraint_method => 'image_max_dimensions',
- params => [\200,\200],
- }
- }
-};
-
-$dfv = Data::FormValidator->new({ profile_3 => $profile_3});
-($valid,$missing,$invalid) = $dfv->validate($q, 'profile_3');
-
-ok(exists $valid->{'100x100_gif'}, 'expecting success with max_dimensions using constraint_regexp_map');
-
-#use Data::Dumper;
-#warn Dumper ($invalid);
-
-ok((grep {m/300x300/} @$invalid), 'expecting failure with max_dimensions using constraint_regexp_map');
-
-
Deleted: packages/libdata-formvalidator-perl/branches/upstream/current/t/29_regexp_common.t
===================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/29_regexp_common.t 2005-09-01 23:29:39 UTC (rev 1335)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/29_regexp_common.t 2005-09-06 20:48:58 UTC (rev 1336)
@@ -1,71 +0,0 @@
-# Integration with Regexp::Common;
-
-use Test::More tests => 10;
-
-use Data::FormValidator;
-
-my %FORM = (
- bad_ip => '127 0 0 1',
- good_ip => '127.0.0.1',
- embedded_ip => 'The address is 127.0.0.1 or something close to that',
-);
-
-my $results;
-
-eval {
-$results = Data::FormValidator->check(\%FORM, {
- required => [qw/good_ip bad_ip/],
- constraint_regexp_map => {
- qr/_ip$/ => 'RE_net_IPv4',
-
- }
- });
-};
-ok((not $@), 'runtime errors') or diag $@;
-ok($results->valid->{good_ip}, 'good ip');
-ok($results->invalid->{bad_ip}, 'bad ip');
-
-
-$results = Data::FormValidator->check(\%FORM, {
- untaint_all_constraints => 1,
- required => [qw/good_ip bad_ip/],
- constraint_regexp_map => {
- qr/_ip$/ => 'RE_net_IPv4',
-
- }
- });
-
-
-ok((not $@), 'runtime errors') or diag $@;
-ok($results->valid->{good_ip}, 'good ip with tainting');
-ok($results->invalid->{bad_ip}, 'bad ip with tainting');
-
-# Test passing flags
-$results = Data::FormValidator->check(\%FORM, {
- required => [qw/good_ip bad_ip/],
- constraint_regexp_map => {
- qr/_ip$/ => {
- constraint => 'RE_net_IPv4_dec',
- params => [ \'-sep'=> \' ' ],
- }
- }
- });
-
-
-ok((not $@), 'runtime errors') or diag $@;
-# Here we are trying passing a parameter which should reverse
-# the notion of which one expect to succeed.
-ok($results->valid->{bad_ip}, 'expecting success with params');
-ok($results->invalid->{good_ip}, 'expecting failure with params');
-
-
-# Testing end-to-end matching
-$results = Data::FormValidator->check(\%FORM, {
- required => [qw/embedded_ip/],
- constraint_regexp_map => {
- qr/_ip$/ => 'RE_net_IPv4',
- }
- });
-my $invalid = scalar $results->invalid || {};
-ok($invalid->{embedded_ip}, 'testing that the RE must match from end-to-end');
-
Deleted: packages/libdata-formvalidator-perl/branches/upstream/current/t/99_pod.t
===================================================================
--- packages/libdata-formvalidator-perl/branches/upstream/current/t/99_pod.t 2005-09-01 23:29:39 UTC (rev 1335)
+++ packages/libdata-formvalidator-perl/branches/upstream/current/t/99_pod.t 2005-09-06 20:48:58 UTC (rev 1336)
@@ -1,36 +0,0 @@
-use Test::More;
-
-# Check our Pod
-# The test was provided by Andy Lester,
-# who stole it from Brian D. Foy
-# Thanks to both !
-
-use File::Spec;
-use File::Find;
-use strict;
-
-eval {
- require Test::Pod;
- Test::Pod->import;
-};
-
-my @files;
-
-if ($@) {
- plan skip_all => "Test::Pod required for testing POD";
-}
-elsif ($Test::Pod::VERSION < 0.95) {
- plan skip_all => "Test::Pod 0.95 required for testing POD";
-}
-else {
- my $blib = File::Spec->catfile(qw(blib lib));
- find(\&wanted, $blib, 'lib');
- plan tests => scalar @files;
- foreach my $file (@files) {
- pod_file_ok($file);
- }
-}
-
-sub wanted {
- push @files, $File::Find::name if /\.p(l|m|od)$/;
-}
Copied: packages/libdata-formvalidator-perl/branches/upstream/current/t/dates.t (from rev 1335, packages/libdata-formvalidator-perl/branches/upstream/current/t/23_dates.t)
Copied: packages/libdata-formvalidator-perl/branches/upstream/current/t/missing_optional.t (from rev 1335, packages/libdata-formvalidator-perl/branches/upstream/current/t/07_missing_optional.t)
Copied: packages/libdata-formvalidator-perl/branches/upstream/current/t/msgs.t (from rev 1335, packages/libdata-formvalidator-perl/branches/upstream/current/t/22_msgs.t)
Copied: packages/libdata-formvalidator-perl/branches/upstream/current/t/pod.t (from rev 1335, packages/libdata-formvalidator-perl/branches/upstream/current/t/99_pod.t)
Copied: packages/libdata-formvalidator-perl/branches/upstream/current/t/profile_checking.t (from rev 1335, packages/libdata-formvalidator-perl/branches/upstream/current/t/08_profile_checking.t)
Copied: packages/libdata-formvalidator-perl/branches/upstream/current/t/regexp_common.t (from rev 1335, packages/libdata-formvalidator-perl/branches/upstream/current/t/29_regexp_common.t)
Copied: packages/libdata-formvalidator-perl/branches/upstream/current/t/simple.t (from rev 1335, packages/libdata-formvalidator-perl/branches/upstream/current/t/01_simple.t)
Copied: packages/libdata-formvalidator-perl/branches/upstream/current/t/untaint.pl (from rev 1335, packages/libdata-formvalidator-perl/branches/upstream/current/t/12_untaint.pl)
Copied: packages/libdata-formvalidator-perl/branches/upstream/current/t/untaint.t (from rev 1335, packages/libdata-formvalidator-perl/branches/upstream/current/t/12_untaint.t)
Copied: packages/libdata-formvalidator-perl/branches/upstream/current/t/upload.t (from rev 1335, packages/libdata-formvalidator-perl/branches/upstream/current/t/24_upload.t)
More information about the Pkg-perl-cvs-commits
mailing list