Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

How do I code multiple failure modes for Data::FormValidator field validations?

by thezip (Vicar)
on Nov 15, 2010 at 20:20 UTC ( #871571=perlquestion: print w/ replies, xml ) Need Help??
thezip has asked for the wisdom of the Perl Monks concerning the following question:

Good monks,

Given the following HTML form, I want to establish validations of the data via Data::FormValidator, and then report the errors with HTML::Template.

I cannot seem to get the third failure mode to work correctly, probably because I'm visualizing the interface incorrectly. Please help.

Here is a simplistic version of the form:

<form method="post"> <input type="text" name="Field1"><br> <input type="text" name="Field2"><br> <input type="submit"> </form>
Let's say that I want to have three failures modes:
  • Field1 is not a positive integer
  • Field2 is not a positive integer
  • Field2 is not greater than Field1
Here is the template:
sub error_template { return qq( <html> <head> <title>Results</title> </head> <body> <h2>Results</h2> <p>I'm sorry, but I had a slight problem processing your form submissi +on:</p> <ul> <!-- TMPL_IF NAME="err_Field1" --> <li>You must enter a valid number for Field1</li> <!-- /TMPL_IF --> <!-- TMPL_IF NAME="err_Field2" --> <li>You must enter a valid number for Field2</li> <!-- /TMPL_IF --> <!-- TMPL_IF NAME="err_Field2_LT_Field1" --> <li>Field2 must be >= Field1</li> <!-- /TMPL_IF --> </ul> </body> </html> );

In the above template, the conditional for "err_Field2_LT_Field1" doesn't execute during a failure. This is the issue I'm trying to work out.

Now for the Data::FormValidator code:
sub compare_num1_LT_num2 { my ($first, $second) = @_; return ($first <= $second); } sub validate { my $data_in = shift; my $maxint = 10000; my $profile = { 'required' => [ qw( Field1 Field2 ) ], 'msgs' => { 'prefix' => 'err_' }, 'constraints' => { 'Field1' => sub { my $in = shift; $in =~ /^\d+$/ && $in > 0 && $in < $maxint }, 'Field2' => sub { my $in = shift; $in =~ /^\d+$/ && $in > 0 && $in < $maxint }, 'Field2_LT_Field1' => { 'constraint' => 'compare_num1_LT_num2', 'params' => [ qw/ Field1 Field2 / ], }, }, }; my $results = Data::FormValidator->check($data_in, $profile); } validate(\%data);

Please forgive me if this code does not compile correctly, as it has been excerpted from a larger bit of code, and is intended for illustrative purposes only.

Thank you in advance for your help.



What can be asserted without proof can be dismissed without proof. - Christopher Hitchens

Comment on How do I code multiple failure modes for Data::FormValidator field validations?
Select or Download Code
Replies are listed 'Best First'.
Re: How do I code multiple failure modes for Data::FormValidator field validations?
by trwww (Priest) on Nov 15, 2010 at 23:37 UTC

    This is probably the profile I'd use for the requirements:

    our $profile = { filters => ['trim'], required => [ 'Field1', 'Field2', ], constraint_methods => { 'Field1' => [ { name => 'not_positive', constraint_method => sub { my ($dfv, $val) = @_; return $val =~ /\A\d+\z/, } }, ], 'Field2' => [ { name => 'not_positive', constraint_method => sub { my ($dfv, $val) = @_; return $val =~ /\A\d+\z/, }, }, { name => 'field2_too_big', params => [ qw(Field1 Field2) ], constraint_method => sub { my ($dfv, $f1, $f2) = @_; no warnings qw(uninitialized); return $f2 < $f1; }, }, ], }, msgs => { invalid_seperator => ' ## ', format => 'ERROR: %s', missing => 'FIELD IS REQUIRED', invalid => 'FIELD IS INVALID', prefix => 'err_', constraints => { not_positive => 'MUST BE POSITIVE', field2_too_big => 'MUST BE < Field1', } }, };

    Observe:

    use warnings; use strict; use Data::FormValidator; use Test::More tests => 15; our $profile = { filters => ['trim'], required => [ 'Field1', 'Field2', ], constraint_methods => { 'Field1' => [ { name => 'not_positive', constraint_method => sub { my ($dfv, $val) = @_; return $val =~ /\A\d+\z/, } }, ], 'Field2' => [ { name => 'not_positive', constraint_method => sub { my ($dfv, $val) = @_; return $val =~ /\A\d+\z/, }, }, { name => 'field2_too_big', params => [ qw(Field1 Field2) ], constraint_method => sub { my ($dfv, $f1, $f2) = @_; no warnings qw(uninitialized); return $f2 < $f1; }, }, ], }, msgs => { invalid_seperator => ' ## ', format => 'ERROR: %s', missing => 'FIELD IS REQUIRED', invalid => 'FIELD IS INVALID', prefix => 'err_', constraints => { not_positive => 'MUST BE POSITIVE', field2_too_big => 'MUST BE < Field1', } }, }; my($results, %msgs); isa_ok( $results = Data::FormValidator->check( {}, $profile ) => 'Data::FormValidator::Results' ); ok(! $results->success, 'data is invalid'); %msgs = %{$results->msgs}; while( my($k, $v) = each(%msgs) ) { is($v => 'ERROR: FIELD IS REQUIRED', "$k is required") } isa_ok( $results = Data::FormValidator->check( { Field1 => -10 }, $profile ) => 'Data::FormValidator::Results' ); ok(! $results->success, 'data is invalid'); is( $results->msgs->{err_Field1} => 'ERROR: MUST BE POSITIVE', 'Field1 must be positive' ); isa_ok( $results = Data::FormValidator->check( { Field2 => -10 }, $profile ) => 'Data::FormValidator::Results' ); ok(! $results->success, 'data is invalid'); is( $results->msgs->{err_Field2} => 'ERROR: MUST BE POSITIVE', 'Field2 must be positive' ); isa_ok( $results = Data::FormValidator->check( { Field1 => 5, Field2 => 20 }, $profile ) => 'Data::FormValidator::Results' ); ok(! $results->success, 'data is invalid'); is( $results->msgs->{err_Field2} => 'ERROR: MUST BE < Field1', 'Field2 must less than Field1' ); isa_ok( $results = Data::FormValidator->check( { Field1 => 20, Field2 => 5 }, $profile ) => 'Data::FormValidator::Results' ); ok($results->success, 'data is valid');

    Output:

    $ prove -v test.pl test.pl .. 1..15 ok 1 - The object isa Data::FormValidator::Results ok 2 - data is invalid ok 3 - err_Field1 is required ok 4 - err_Field2 is required ok 5 - The object isa Data::FormValidator::Results ok 6 - data is invalid ok 7 - Field1 must be positive ok 8 - The object isa Data::FormValidator::Results ok 9 - data is invalid ok 10 - Field2 must be positive ok 11 - The object isa Data::FormValidator::Results ok 12 - data is invalid ok 13 - Field2 must less than Field1 ok 14 - The object isa Data::FormValidator::Results ok 15 - data is valid ok All tests successful. Files=1, Tests=15, 1 wallclock secs ( 0.03 usr 0.01 sys + 0.04 cusr + 0.00 csys = 0.08 CPU) Result: PASS
Re: How do I code multiple failure modes for Data::FormValidator field validations?
by ww (Bishop) on Nov 15, 2010 at 21:46 UTC

    zip:

    Stricken as part of the update (below) because this is just plain wrong: Despite the title (and what I construe to be needless use of Data::FormValidator) /me thinks your problem is the attempt at comparison in your first sub.

    Here's my stab at what I think (lacking code that does actually compile) you intend:

    #!/usr/bin/perl # 871571 use strict; use warnings; my $num1 = 4; my $num2 = 4; my ($return1, $return2) = compare_num1_LT_num2($num1, $num2); print "\tBACK IN MAIN: \n"; { no warnings ("uninitialized"); if ($return1 eq 'NoWay') { print "\t $num1 is GT or EQUAL to $num2\n"; } else { print "\$return1: $return1 and \$return2: $return2\n\n"; } } print "Done\n\n"; sub compare_num1_LT_num2 { my ($first, $second) = @_; print "In sub compare... $first, $second\n"; if ( $first >= $second ) { return ('NoWay'); } else { return ( $first, $second ); } }

    which returns

    In sub compare... 4, 4 BACK IN MAIN: 4 is GT or EQUAL to 4 Done

    Change $num1 to 3, and this is the output:

    In sub compare... 3, 4 BACK IN MAIN: $return1: 3 and $return2: 4 Done

    Lottsa' un-needed code and detail here... but that's the way my mind works (when it works).

    Update (1712 EST): Based on exchange of msgs and a much needed bit of education (FROM thezip to /me), the compare...() returns 1 or 0, T or F, which is then supposed to be parsed by Data::FormValidator... meaning that portion of my reply (above) is probably most valuable as an object lesson to those ( points to self) who would mis-interpret a bit of legit syntax. Apologies.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://871571]
Approved by Corion
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (14)
As of 2015-07-07 22:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (93 votes), past polls