The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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;