r21918 - in /branches/upstream/libdata-formvalidator-perl/current: ./ lib/Data/ lib/Data/FormValidator/ lib/Data/FormValidator/Constraints/ t/

rmayorga-guest at users.alioth.debian.org rmayorga-guest at users.alioth.debian.org
Fri Jun 20 02:43:04 UTC 2008


Author: rmayorga-guest
Date: Fri Jun 20 02:43:04 2008
New Revision: 21918

URL: http://svn.debian.org/wsvn/?sc=1&rev=21918
Log:
[svn-upgrade] Integrating new upstream version, libdata-formvalidator-perl (4.61)

Added:
    branches/upstream/libdata-formvalidator-perl/current/t/dependency_coderef.t
    branches/upstream/libdata-formvalidator-perl/current/t/upload_mime_types.t
Removed:
    branches/upstream/libdata-formvalidator-perl/current/Makefile.PL
Modified:
    branches/upstream/libdata-formvalidator-perl/current/Build.PL
    branches/upstream/libdata-formvalidator-perl/current/Changes
    branches/upstream/libdata-formvalidator-perl/current/MANIFEST
    branches/upstream/libdata-formvalidator-perl/current/MANIFEST.SKIP
    branches/upstream/libdata-formvalidator-perl/current/META.yml
    branches/upstream/libdata-formvalidator-perl/current/README
    branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator.pm
    branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints.pm
    branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints/Dates.pm
    branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints/Upload.pm
    branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Filters.pm
    branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Results.pm
    branches/upstream/libdata-formvalidator-perl/current/t/FV_length.t
    branches/upstream/libdata-formvalidator-perl/current/t/dates_closure.t
    branches/upstream/libdata-formvalidator-perl/current/t/procedural_valid.t

Modified: branches/upstream/libdata-formvalidator-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/Build.PL?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/Build.PL (original)
+++ branches/upstream/libdata-formvalidator-perl/current/Build.PL Fri Jun 20 02:43:04 2008
@@ -49,6 +49,7 @@
         'overload'        => 0,
         'Perl6::Junction' => 1.10, 
         'Scalar::Util'    => 0,
+        'Email::Valid'    => 0,
 	},
 )->create_build_script;
 

Modified: branches/upstream/libdata-formvalidator-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/Changes?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/Changes (original)
+++ branches/upstream/libdata-formvalidator-perl/current/Changes Fri Jun 20 02:43:04 2008
@@ -1,3 +1,32 @@
+4.61 Mon Jun 16 14:37:31 EDT 2008
+
+    [INTERNALS]
+    - packaging issue from Perl 4.60 resolved.
+
+4.60 Mon Jun 16 14:10:14 EDT 2008
+
+    [NEW FEATURES]
+    - Dependencies can now be specified using a code ref.
+      Thanks to Bradley C Bailey, via RT#24935.
+
+    [BUG FIXES]
+    - length constraints for min, max and 'between' now work for lengths
+       of 32k and longer. (Carl Vincent). 
+    - We now use Email::Valid to validate e-mail addresses instead of
+      our own regrex. Email::Valid passed all our our existing regression
+      tests for e-mail addresses that should pass and fail. Email::Valid
+      also correctly recognizes emails with single quote characters in them.
+      These are valid, but our regex didn't recognize them.  (Mark Stosberg)
+
+    [INTERNALS]
+    - Typo in Constraints documentation corrected by K B Shiv Kumar (RT#32358)
+    - Add some tests and docs for "date_and_time" constraint, from
+      Data::FormValidator:::Constraints::Dates.  It appears  there may still
+      exist a leap-year bug with the date parser. See the TODO test in
+      t/dates_closure.t for details. An alternative is to use
+      Data::FormValidator::Constraints::DateTime 
+      (Mark Stosberg, Matt Christian)
+
 4.57 Thu Nov  1 22:47:13 EDT 2007
     [BUG FIXES]
     - The min max and length_between constraints now allow multi-line input, 

Modified: branches/upstream/libdata-formvalidator-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/MANIFEST?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/MANIFEST (original)
+++ branches/upstream/libdata-formvalidator-perl/current/MANIFEST Fri Jun 20 02:43:04 2008
@@ -3,7 +3,6 @@
 MANIFEST			This list of files
 MANIFEST.SKIP
 META.yml
-Makefile.PL
 README
 RELEASE_NOTES
 lib/Data/FormValidator.pm
@@ -51,6 +50,7 @@
 t/credit_card.t
 t/dates.t
 t/dates_closure.t
+t/dependency_coderef.t
 t/dependency_groups.t
 t/filter_constraints.t
 t/filters_builtin.t
@@ -75,6 +75,7 @@
 t/untaint.t
 t/upload.t
 t/upload_closure.t
+t/upload_mime_types.t
 t/upload_post_text.txt
 test/00_base.badformat
 test/00_base.profile

Modified: branches/upstream/libdata-formvalidator-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/MANIFEST.SKIP?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libdata-formvalidator-perl/current/MANIFEST.SKIP Fri Jun 20 02:43:04 2008
@@ -25,6 +25,7 @@
 _darcs
 _build
 patches
+lib/Perl6
 rejects
 ^Build$
 

Modified: branches/upstream/libdata-formvalidator-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/META.yml?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/META.yml (original)
+++ branches/upstream/libdata-formvalidator-perl/current/META.yml Fri Jun 20 02:43:04 2008
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name: Data-FormValidator
-version: 4.57
+version: 4.61
 author:
   - Mark Stosberg <mark at summersault.com>
 abstract: |-
@@ -9,6 +9,7 @@
 license: perl
 requires:
   Date::Calc: 5
+  Email::Valid: 0
   File::MMagic: 1.17
   Image::Size: 0
   MIME::Types: 1.005
@@ -21,26 +22,26 @@
 provides:
   Data::FormValidator:
     file: lib/Data/FormValidator.pm
-    version: 4.57
+    version: 4.61
   Data::FormValidator::Constraints:
     file: lib/Data/FormValidator/Constraints.pm
-    version: 4.51
+    version: 4.6
   Data::FormValidator::Constraints::Dates:
     file: lib/Data/FormValidator/Constraints/Dates.pm
-    version: 1.01
+    version: 4.60
   Data::FormValidator::Constraints::RegexpCommon:
     file: lib/Data/FormValidator/Results.pm
-    version: 4.55
+    version: 4.6
   Data::FormValidator::Constraints::Upload:
     file: lib/Data/FormValidator/Constraints/Upload.pm
-    version: 4.55
+    version: 4.6
   Data::FormValidator::ConstraintsFactory:
     file: lib/Data/FormValidator/ConstraintsFactory.pm
     version: 1.6
   Data::FormValidator::Filters:
     file: lib/Data/FormValidator/Filters.pm
-    version: 4.1
+    version: 4.6
   Data::FormValidator::Results:
     file: lib/Data/FormValidator/Results.pm
-    version: 4.55
+    version: 4.6
 generated_by: Module::Build version 0.2611

Modified: branches/upstream/libdata-formvalidator-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/README?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/README (original)
+++ branches/upstream/libdata-formvalidator-perl/current/README Fri Jun 20 02:43:04 2008
@@ -236,6 +236,15 @@
         "pay_type" => {
             check => [ qw( check_no ) ],
          }
+
+        # if cc_type is VISA or MASTERCARD require CVV
+        "cc_type" => sub {
+            my $dfv  = shift;
+            my $type = shift;
+        
+            return [ 'cc_cvv' ] if ($type eq "VISA" || $type eq "MASTERCARD");
+            return [ ];
+        },
      },
 
     This is for the case where an optional field has other requirements. The
@@ -245,7 +254,12 @@
     additional constraint is added that the optional field must equal a key
     for the dependencies to be added.
 
-    Any fields in the dependencies list that is missing when the target is
+    If the dependencies are specified as a code reference then the code will
+    be executed to determine the dependent fields. It is passed two
+    parameters, the object and the value of the field, and it should return
+    an array reference containing the list of dependent fields.
+
+    Any fields in the dependencies list that are missing when the target is
     present will be reported as missing.
 
   dependency_groups

Modified: branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator.pm?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator.pm (original)
+++ branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator.pm Fri Jun 20 02:43:04 2008
@@ -33,7 +33,7 @@
 
 use vars qw( $VERSION $AUTOLOAD @ISA @EXPORT_OK %EXPORT_TAGS );
 
-$VERSION = '4.57';
+$VERSION = '4.61';
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -443,6 +443,15 @@
     "pay_type" => {
         check => [ qw( check_no ) ],
      }
+
+    # if cc_type is VISA or MASTERCARD require CVV
+    "cc_type" => sub {
+        my $dfv  = shift;
+        my $type = shift;
+        
+        return [ 'cc_cvv' ] if ($type eq "VISA" || $type eq "MASTERCARD");
+        return [ ];
+    },
  },
 
 This is for the case where an optional field has other requirements.  The
@@ -452,7 +461,12 @@
 constraint is added that the optional field must equal a key for the
 dependencies to be added.
 
-Any fields in the dependencies list that is missing when the target is present
+If the dependencies are specified as a code reference then the code will be
+executed to determine the dependent fields.  It is passed two parameters,
+the object and the value of the field, and it should return an array reference
+containing the list of dependent fields.
+
+Any fields in the dependencies list that are missing when the target is present
 will be reported as missing.
 
 =head2 dependency_groups

Modified: branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints.pm?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints.pm (original)
+++ branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints.pm Fri Jun 20 02:43:04 2008
@@ -23,7 +23,7 @@
 use strict;
 use vars qw/$AUTOLOAD @ISA @EXPORT_OK %EXPORT_TAGS $VERSION/;
 
-$VERSION = 4.51;
+$VERSION = 4.60;
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -261,6 +261,8 @@
 
 The checks are all inclusive, so a max length of '100' will allow the length 100. 
 
+Length is measured in perl characters as opposed to bytes or anything else.
+
 This constraint I<will> untaint your data if you have untainting turned on. However,
 a length check alone may not be enough to insure the safety of the data you are receiving.
 Using additional constraints to check the data is encouraged. 
@@ -275,8 +277,10 @@
     return sub {
         my ($dfv,$value) = @_;
         $dfv->name_this('length_between');
-        my ($match) = ($value =~ m/\A(.{$min,$max})\z/xms);
-        return $dfv->untainted_constraint_value($match);
+        return undef if ( ( length($value) > $max ) || ( length($value) < $min) );
+        # Use a regexp to untaint
+        $value=~/(.*)/;
+        return $dfv->untainted_constraint_value($1);
     }
 }
 
@@ -286,8 +290,10 @@
     return sub {
         my ($dfv,$value) = @_;
         $dfv->name_this('max_length');
-        my ($match) = ($value =~ m/\A(.{0,$max})\z/xms);
-        return $dfv->untainted_constraint_value($match);
+        return undef if ( length($value) > $max );
+        # Use a regexp to untaint
+        $value=~/(.*)/;
+        return $dfv->untainted_constraint_value($1);
     }
 }
 
@@ -297,8 +303,10 @@
     return sub {
         my ($dfv,$value) = @_;
         $dfv->name_this('min_length');
-        my ($match) = ($value =~ m/\A(.{$min,})\z/xms);
-        return $dfv->untainted_constraint_value($match);
+        return undef if ( length($value) < $min );
+        # Use a regexp to untaint
+        $value=~/(.*)/;
+        return $dfv->untainted_constraint_value($1);
     }
 }
 
@@ -348,13 +356,19 @@
 # Copyright 1996-1999 by Michael J. Heins <mike at heins.net>
 
 sub match_email {
-    my $email = shift;
-
-    if ($email =~ /^(([a-z0-9_\.\+\-\=\?\^\#]){1,64}\@(([a-z0-9\-]){1,251}\.){1,252}[a-z0-9]{2,4})$/i) {
-	    return $1;
-    }
-    else { 
-        return undef; 
+    my $in_email = shift;
+
+    require Email::Valid;
+    my $valid_email; 
+
+    # The extra check that the result matches the input prevents
+    # an address like this from being considered valid: Joe Smith <joe at smith.com>
+    if (    ($valid_email = Email::Valid->address($in_email) )
+        and ($valid_email eq $in_email)) { 
+        return $valid_email;
+    }
+    else {
+        return undef;
     }
 }
 
@@ -736,7 +750,7 @@
   # Near your profile	
   # Of course, you don't have to export/import if your constraints are in the same
   # package as the profile.  
-  use My::Constraints qw(coolness);
+  use My::Constraints 'coolness';
 
   # In your profile
   constraint_methods => {
@@ -769,7 +783,7 @@
 		# get other data to refer to
 	    my $data = $dfv->get_filtered_data;
 
-	    my $has_all_three = ($data->{personality} && $data->{smarts} && $data->{looks});
+	    my $has_all_three = ($data->{$personality} && $data->{$smarts} && $data->{$looks});
 		return ( ($val >= $min_cool) && ($val <= $max_cool) && $has_all_three );
 	}
   }

Modified: branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints/Dates.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints/Dates.pm?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints/Dates.pm (original)
+++ branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints/Dates.pm Fri Jun 20 02:43:04 2008
@@ -28,7 +28,7 @@
 	match_date_and_time
 );
 
-$VERSION = '1.01';
+$VERSION = '4.60';
 
 sub date_and_time {
 	my $fmt = shift;

Modified: branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints/Upload.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints/Upload.pm?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints/Upload.pm (original)
+++ branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Constraints/Upload.pm Fri Jun 20 02:43:04 2008
@@ -28,7 +28,7 @@
 	image_min_dimensions
 );
 
-$VERSION = 4.55;
+$VERSION = 4.60;
 
 sub file_format {
 	my %params = @_;

Modified: branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Filters.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Filters.pm?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Filters.pm (original)
+++ branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Filters.pm Fri Jun 20 02:43:04 2008
@@ -13,7 +13,7 @@
 use strict;
 use vars qw/$AUTOLOAD @ISA @EXPORT_OK %EXPORT_TAGS $VERSION/;
 
-$VERSION = 4.1;
+$VERSION = 4.60;
 
 require Exporter;
 @ISA = qw(Exporter);

Modified: branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Results.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Results.pm?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Results.pm (original)
+++ branches/upstream/libdata-formvalidator-perl/current/lib/Data/FormValidator/Results.pm Fri Jun 20 02:43:04 2008
@@ -24,7 +24,7 @@
   'bool' => \&_bool_overload_based_on_success,
   fallback => 1;
 
-$VERSION = 4.55;
+$VERSION = 4.60;
 
 =pod
 
@@ -237,6 +237,15 @@
 					}
 				}
 			}
+            elsif (ref $deps eq "CODE") {
+                for my $val (_arrayify($valid{$field})) {
+                    my $returned_deps = $deps->($self, $val);
+                
+                    for my $dep (_arrayify($returned_deps)) {
+                        $required{$dep} = 1;
+                    }
+                }
+            }
             else {
                 for my $dep (_arrayify($deps)){
                     $required{$dep} = 1;

Modified: branches/upstream/libdata-formvalidator-perl/current/t/FV_length.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/t/FV_length.t?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/t/FV_length.t (original)
+++ branches/upstream/libdata-formvalidator-perl/current/t/FV_length.t Fri Jun 20 02:43:04 2008
@@ -71,3 +71,44 @@
 ok( $multiline_result->valid('echo'),      'multiline FV_length_between in bounds');
 ok( $multiline_result->invalid('foxtrot'), 'multiline FV_length_between too short');
 ok( $multiline_result->invalid('golf'),    'multiline FV_length_between too long' );
+
+# Test "long" results. Early implementations checked length with
+# regular expressions which limit length options to 32kb.
+# The 80000 char test string is an arbitrary length.
+# good a value as any other. And it's pretty long. 
+# Just for good measure we'll use the unicode smiley character (as seen in
+# perluniintro) in our test string.
+
+my $smiley = "\x{263a}";                # Thats "smiling face, white" folks!
+my $long_string = "x$smiley" x 40000;   # results in a 80000 length string
+my $long_result = Data::FormValidator->check(
+    {
+        alpha   => $long_string,
+        beta    => $long_string,
+        charlie => $long_string,
+        delta   => $long_string,
+        echo    => $long_string,
+        foxtrot => $long_string,
+        golf    => $long_string,
+    },
+    {
+        required => [qw/alpha beta charlie delta echo foxtrot golf/],
+        constraint_methods => {
+            alpha   => FV_max_length(80000),        # max length
+            beta    => FV_max_length(79999),        # too long
+            charlie => FV_min_length(80000),        # just long enough
+            delta   => FV_min_length(80001),        # too short
+            echo    => FV_length_between(79999,80001),    # just right 
+            foxtrot => FV_length_between(80001,80000),    # too short
+            golf    => FV_length_between(70000,79999),    # too long
+        },
+    },
+);
+
+ok( $long_result->valid('alpha'),     'long FV_max_length in bounds'    );
+ok( $long_result->invalid('beta'),    'long FV_max_length too long'     );
+ok( $long_result->valid('charlie'),   'long FV_min_length in bounds'    );
+ok( $long_result->invalid('delta'),   'long FV_min_length too short'    );
+ok( $long_result->valid('echo'),      'long FV_length_between in bounds');
+ok( $long_result->invalid('foxtrot'), 'long FV_length_between too short');
+ok( $long_result->invalid('golf'),    'long FV_length_between too long' );

Modified: branches/upstream/libdata-formvalidator-perl/current/t/dates_closure.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/t/dates_closure.t?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/t/dates_closure.t (original)
+++ branches/upstream/libdata-formvalidator-perl/current/t/dates_closure.t Fri Jun 20 02:43:04 2008
@@ -1,5 +1,5 @@
 #!/usr/bin/perl -w
-use Test::More qw/no_plan/;
+use Test::More 'no_plan';
 BEGIN { 
 	use_ok('Data::FormValidator::Constraints::Dates') 
 };
@@ -59,4 +59,33 @@
 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');
 
+{
+    my $r = Data::FormValidator->check({
+        # Testing leap years
+        date_and_time_field_good    => '02/29/2008',
+        date_and_time_field_bad_pat => '02/29/2008',
+        leap_seventy_six            => '02/29/1976',
+    },	
+    {
+        required => [qw/date_and_time_field_good date_and_time_field_bad_pat/],
+        constraint_methods => {
+            'date_and_time_field_good'    => date_and_time('MM/DD/YY(?:YY)?'),
+            # This pattern actually tests with a 3 digit year, not a four digit year, and fails
+            # on the date 02/29/2008, because 02/29/200 doesn't exist. 
+            'date_and_time_field_bad_pat' => date_and_time('MM/DD/YYY?Y?'),
+            'leap_seventy_six'            => date_and_time('MM/DD/YY(?:YY)?'),
+        },
+   });
+   my $valid = $r->valid;
+   ok ($valid->{date_and_time_field_good}, '02/29/2008 should pass MM/DD/YY(?:YY)?');
 
+   TODO: {
+       local $TODO = "leap year bug?";
+       ok ($valid->{leap_seventy_six},         '02/29/1976 should pass MM/DD/YY(?:YY)?');
+    };
+
+   # This one fails not because the date is bad, but because the pattern is not sensible
+   # It would be better to detect that the pattern was bad and fail that way, of course.
+   ok ( $r->invalid('date_and_time_field_bad_pat'), "02/29/2008 should fail MM/DD/YYY?Y?" );
+
+}

Added: branches/upstream/libdata-formvalidator-perl/current/t/dependency_coderef.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/t/dependency_coderef.t?rev=21918&op=file
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/t/dependency_coderef.t (added)
+++ branches/upstream/libdata-formvalidator-perl/current/t/dependency_coderef.t Fri Jun 20 02:43:04 2008
@@ -1,0 +1,96 @@
+use strict;
+
+$^W = 1;
+
+use Test::More tests => 18;
+use Data::FormValidator;
+
+my %code_results  = ( );
+my $input_hashref = { };
+my $input_profile = {
+    dependencies => {
+        cc_type => sub {
+            my $dfv  = shift;
+            my $type = shift;
+            
+            return [ 'cc_cvv' ] if ($type eq "VISA" || $type eq "MASTERCARD");
+            return [ ];
+        },
+
+        code_checker => sub {
+            my($dfv, $val) = @_;
+
+            $code_results{'code_called'} = 1;
+            $code_results{'num_args'} = @_;
+            $code_results{'value'} = $val;
+            $code_results{'dfv_obj'} = $dfv;
+
+            return [ ];
+        },
+    },
+};
+
+my $validator = Data::FormValidator->new({default => $input_profile});
+my $result;
+
+
+##
+## Validate a coderef dependency
+##
+
+
+## Check that the code actually gets called.
+#############################################################################
+
+$input_hashref->{code_checker} = 'test';
+$result = undef;
+eval { $result = $validator->check($input_hashref, 'default'); };
+
+ok(!$@, "checking that dependency coderef is called");
+ok($code_results{code_called}, "  code was called");
+is($code_results{num_args}, 2, "  code received 2 args");
+is($code_results{value}, 'test', "  received correct value");
+ok($code_results{dfv_obj}, "  received dfv object");
+isa_ok($code_results{dfv_obj}, 'Data::FormValidator::Results',
+    "  dfv object");
+
+delete $input_hashref->{code_checker};
+
+
+## Value that should cause a missing dependency.
+#############################################################################
+
+$input_hashref->{cc_type} = 'VISA';
+$result = undef;
+eval { $result = $validator->check($input_hashref, 'default'); };
+
+ok(!$@, "checking a value that has a depenency");
+isa_ok($result, "Data::FormValidator::Results", "  returned object");
+ok($result->has_missing, "  has_missing returned true");
+ok($result->missing('cc_cvv'),  "  missing('cc_cvv') returned true");
+
+
+## Value that should NOT cause a missing dependency.
+#############################################################################
+
+$input_hashref->{cc_type} = 'AMEX';
+$result = undef;
+eval { $result = $validator->check($input_hashref, 'default'); };
+
+ok(!$@, "checking a value that has no dependencies");
+isa_ok($result, "Data::FormValidator::Results", "  returned object");
+ok(!$result->has_missing, "  has_missing returned false");
+is($result->missing('cc_cvv'), undef, "  missing('cc_cvv') returned false");
+
+
+## Test with multiple values
+#############################################################################
+
+$input_hashref->{cc_type} = [ 'AMEX', 'VISA' ];
+$result = undef;
+eval { $result = $validator->check($input_hashref, 'default'); };
+
+ok(!$@, "checking multiple values");
+isa_ok($result, "Data::FormValidator::Results", "  returned object");
+ok($result->has_missing, "  has_missing returned true");
+is($result->missing('cc_cvv'), 1, "  missing('cc_cvv') returned true");

Modified: branches/upstream/libdata-formvalidator-perl/current/t/procedural_valid.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/t/procedural_valid.t?rev=21918&op=diff
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/t/procedural_valid.t (original)
+++ branches/upstream/libdata-formvalidator-perl/current/t/procedural_valid.t Fri Jun 20 02:43:04 2008
@@ -96,6 +96,8 @@
 my $address_7 = 'Mark_Stosberg at summersault.com';
 ok(valid_email($address_7), "'$address_7' is a valid e-mail");
 
+my $addr_8 = "Mark_O'Doul\@summersault.com";
+ok(valid_email($addr_8), "'$addr_8' is a valid e-mail");
 
 
 

Added: branches/upstream/libdata-formvalidator-perl/current/t/upload_mime_types.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-formvalidator-perl/current/t/upload_mime_types.t?rev=21918&op=file
==============================================================================
--- branches/upstream/libdata-formvalidator-perl/current/t/upload_mime_types.t (added)
+++ branches/upstream/libdata-formvalidator-perl/current/t/upload_mime_types.t Fri Jun 20 02:43:04 2008
@@ -1,0 +1,30 @@
+# Exercise the _is_allowed_type() helper function
+
+use Test::More tests => 5;
+use strict;
+use_ok('Data::FormValidator::Constraints::Upload');
+
+# Test the negative case
+isnt(
+    Data::FormValidator::Constraints::Upload::_is_allowed_type('foo'),
+    1, "'foo'        not considered an allowed mime type"
+);
+
+# Reality check that a simple jpeg is allowed
+is(
+    Data::FormValidator::Constraints::Upload::_is_allowed_type('image/jpeg'),
+    1, "'image/jpeg'  is considered an allowed mime type"
+);
+
+# Check that we handle case insensitivity
+is(
+    Data::FormValidator::Constraints::Upload::_is_allowed_type('image/JPEG'),
+    1, "'image/JPEG'  is considered an allowed mime type"
+);
+
+# Also ensure progressive jpegs are allowed
+is(
+    Data::FormValidator::Constraints::Upload::_is_allowed_type('image/pjpeg'),
+    1, "'image/pjpeg' is considered an allowed mime type"
+);
+




More information about the Pkg-perl-cvs-commits mailing list