use strict; use warnings; use Test::More; use lib 't/lib'; { package My::Constraints; sub check_something { my $value = shift; return 1 if $value eq 'something'; return 0; } } { package My::Form; use HTML::FormHandler::Moose; extends 'HTML::FormHandler'; use Moose::Util::TypeConstraints; subtype 'Natural' => as 'Int' => where { $_ > 0 }; subtype 'NaturalLessThanTen' => as 'Natural' => where { $_ < 10 } => message { "This number ($_) is not less than ten!" }; coerce 'Num' => from 'Str' => via { 0+$_ }; enum 'RGBColors' => qw(red green blue); no Moose::Util::TypeConstraints; has_field 'message_arrayref' => ( apply => [ { check => qr/aaa/, message => ['Must contain [_1]', 'aaa'] } ], ); has_field 'regex_error' => ( apply => [ { check => qr/xyz/ } ], ); has_field 'regex_correct' => ( apply => [ { check => qr/aaa/, message => 'Must contain aaa' } ], ); has_field 'message_sub' => ( apply => [ { check => [ 'abc' ], message => \&err_message } ] ); sub err_message { my ($value, $field ) = @_; return $field->name . ': Must be "abc"'; } has_field 'set_error' => ( apply => [ { check => [ 'abc', 'bbb' ], message => 'Must be "aaa" or "bbb"' } ] ); has_field 'set_correct' => ( apply => [ { check => [ 'aaa', 'bbb' ], message => 'Must be "aaa" or "bbb"' } ] ); has_field 'callback_error' => ( apply => [ { check => sub { if ( $_[0] =~ /(\d+)/ ) { return $1 > 10 } }, message => 'Must contain number greater than 10', } ] ); has_field 'callback_pass' => ( apply => [ { check => \&check_callback_pass, message => 'Must contain number greater than 10', } ] ); sub check_callback_pass { my ( $value, $field ) = @_; if( $value =~ /(\d+)/ ) { return $1 > 10; } } has_field 'less_than_ten_error' => ( apply => [ 'NaturalLessThanTen' ] ); has_field 'less_than_ten_pass' => ( apply => [ 'NaturalLessThanTen' ] ); has_field 'my_something' => ( apply => [{ check => \&My::Constraints::check_something, message => 'Something is not right' }], ); } my $form = My::Form->new(); ok( $form, 'get form' ); my $params = { message_arrayref => 'xxx', regex_error => 'bbb', regex_correct => 'bbb aaa', set_error => 'ccc', set_correct => 'aaa', callback_error => 'asdf 2', callback_pass => 'asdf 20 asd', less_than_ten_error => 10, less_than_ten_pass => 9, message_sub => 'xyz', my_something => 'nothing', }; $form->process($params); ok( $form->field('message_arrayref')->has_errors, 'message arrayref works' ); ok( $form->field('regex_error')->has_errors, 'regexp constraint - error' ); ok( !$form->field('regex_correct')->has_errors, 'regexp constraint - pass' ); ok( $form->field('regex_correct')->has_value, 'constraints passed - has_value is true' ); is( $form->field('message_sub')->errors->[0], 'message_sub: Must be "abc"', 'error from message sub' ); ok( !$form->field('set_correct')->has_errors, 'set correct' ); ok( $form->field('set_error')->has_errors, 'set error' ); ok( $form->field('callback_error')->has_errors, 'callback constraint - error' ); ok( !$form->field('callback_pass')->has_errors, 'callback constraint - pass' ); ok( $form->field('less_than_ten_error')->has_errors, 'type constraint - error' ); my $message = $form->field('less_than_ten_error')->errors->[0]; is( $message, "This number (10) is not less than ten!", 'type constraint - error message' ); ok( !$form->field('less_than_ten_pass')->has_errors, 'type constraint - pass' ); is( $form->field('my_something')->errors->[0], 'Something is not right', 'check sub from package' ); #warn Dumper( $form ); use Data::Dumper; is_deeply( $form->fif, $params, 'fif is correct'); done_testing;