The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package HTML::FormFu::Constraint::reCAPTCHA;

use Moose;
extends 'HTML::FormFu::Constraint';

use Captcha::reCAPTCHA;
use Scalar::Util qw( blessed );

has _recaptcha_response => ( is => 'rw' );

sub process {
    my ( $self, $params ) = @_;

    # check when condition
    return unless $self->_process_when($params);

    # we need the original query object, as the recaptcha fields aren't
    # real formfu fields, so they won't be in $params
    my $query = $self->form->query;

    my $challenge = $query->param('recaptcha_challenge_field');
    my $response  = $query->param('recaptcha_response_field');

    # constraints are only run if submitted() is true.
    # the recaptcha fields have an implicit Required constraint
    # so throw an error if either field is missing
    if ( !$challenge || !$response ) {
        return $self->mk_errors( {} );
    }

    # check if it's already been run - as a 2nd check to recaptcha.net
    # will otherwise always fail
    my $previous_response = $self->_recaptcha_response;

    if ($previous_response) {
        if ( $previous_response ne 'true' ) {
            return $self->mk_errors( { message => $previous_response, } );
        }
        else {

            # the previous response was OK, so return with no errors
            return;
        }
    }

    my $catalyst_compatible 
        = blessed($query)
        && $query->can('secure')
        && $query->can('address');

    my $captcha = Captcha::reCAPTCHA->new;
    my $privkey = $self->parent->private_key || $ENV{RECAPTCHA_PRIVATE_KEY};

    my $remoteip
        = $catalyst_compatible
        ? $query->address
        : $ENV{REMOTE_ADDR};

    my $result
        = $captcha->check_answer( $privkey, $remoteip, $challenge, $response, );

    # they're human!
    if ( $result->{is_valid} ) {
        $self->_recaptcha_response('true');
        return;
    }

    # response failed
    $self->_recaptcha_resonse( $result->{error} );

    return $self->mk_errors( { message => $result->{error}, } );
}

__PACKAGE__->meta->make_immutable;

1;

__END__

=head1 NAME

HTML::FormFu::Constraint::reCAPTCHA - not for direct use

=head1 DESCRIPTION

This constraint is automatically added by the
L<reCAPTCHA element|HTML::FormFu::Element::reCAPTCHA>, and should not be used
directly.

=head1 SEE ALSO

Is a sub-class of, and inherits methods from L<HTML::FormFu::Constraint>

L<HTML::FormFu>

=head1 AUTHOR

Carl Franks C<cfranks@cpan.org>

=head1 LICENSE

This library is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut