File Coverage

blib/lib/Captcha/noCAPTCHA.pm
Criterion Covered Total %
statement 62 69 89.8
branch 16 20 80.0
condition 10 15 66.6
subroutine 17 18 94.4
pod 10 11 90.9
total 115 133 86.4


line stmt bran cond sub pod time code
1             package Captcha::noCAPTCHA;
2              
3 3     3   2475 use warnings;
  3         4  
  3         120  
4 3     3   13 use strict;
  3         5  
  3         56  
5 3     3   2128 use HTTP::Tiny;
  3         121811  
  3         195  
6 3     3   31 use JSON::PP qw();
  3         4  
  3         2728  
7              
8             our $VERSION = '0.15'; # VERSION
9              
10             sub new {
11 3     3 0 1409 my ($class,$args) = @_;
12 3         10 my $self = bless {} ,$class;
13 3 50       10 $self->site_key($args->{site_key}) || die "site_key required";
14 3 50       11 $self->secret_key($args->{secret_key}) || die "secret_key required";
15 3   50     26 $self->theme($args->{theme} || 'light');
16 3   50     23 $self->noscript($args->{noscript} || 0);
17 3   100     24 $self->api_url($args->{api_url} || 'https://www.google.com/recaptcha/api/siteverify');
18 3   50     21 $self->api_timeout($args->{api_timeout} || 10);
19 3         8 return $self;
20             }
21              
22 8     8 1 17 sub site_key { return shift->_get_set('site_key',@_); }
23 5     5 1 14 sub secret_key { return shift->_get_set('secret_key',@_); }
24 9     9 1 21 sub theme { return shift->_get_set('theme',@_); }
25 10     10 1 22 sub noscript { return shift->_get_set('noscript',@_); }
26 3     3 1 9 sub api_url { return shift->_get_set('api_url',@_); }
27 3     3 1 8 sub api_timeout { return shift->_get_set('api_timeout',@_); }
28 9     9 1 244 sub errors { return shift->{_attrs}->{errors}; }
29 4     4 1 23 sub response { return shift->{_response}; }
30              
31             sub html {
32 5     5 1 455 my ($self) = @_;
33 5   50     14 my $key = $self->site_key || die "site_key required!";
34 5         10 my $theme = $self->theme;
35 5         13 my $output=<
36            
37            
38             EOT
39              
40 5 100       10 if ($self->noscript) {
41 1         7 $output.=<
42            
43            
44            
45            
46            
47            
48            
49            
50            
51            
52            
53            
54             EOT
55             }
56              
57 5         29 return $output;
58             }
59              
60             sub verify {
61 0     0 1 0 my ($self,$value,$ip) = @_;
62 0         0 my $params = $self->_build_request($value,$ip);
63 0         0 my $http = HTTP::Tiny->new(timeout => $self->api_timeout);
64 0         0 my $response = $http->post_form( $self->api_url, $params );
65 0         0 return $self->_parse_response($response);
66             }
67              
68             sub _build_request {
69 2     2   1217 my ($self,$value,$ip) = @_;
70 2         5 $self->{_attrs}->{errors} = [];
71 2         8 my $args = { secret => $self->secret_key };
72 2 50       10 $args->{response} = $value if ($value);
73 2 100       7 $args->{remoteip} = $ip if ($ip);
74 2         6 return $args;
75             }
76              
77             sub _parse_response {
78 9     9   15 my ($self,$response) = @_;
79 9 100 66     34 if (!$response || !ref($response)) {
80 3         6 $self->{_attrs}->{errors} = ['http-tiny-no-response'];
81 3         12 return;
82             }
83 6 100       12 if (!$response->{success}) {
84 2   100     8 my $status = $response->{status} || 0;
85 2         8 $self->{_attrs}->{errors} = [sprintf('status-code-%d',$status)];
86 2         7 return;
87             }
88 4 100       7 if (!$response->{content}) {
89 2         3 $self->{_attrs}->{errors} = ['no-content-returned'];
90 2         7 return;
91             }
92 2         22 my $json = eval {JSON::PP::decode_json($response->{content})};
  2         7  
93 2 50       283 if (!$json) {
94 0         0 $self->{_attrs}->{errors} = ['invalid-json'];
95 0         0 return;
96             }
97 2         3 $self->{_response} = $json;
98 2         4 $self->{_attrs}->{errors} = $json->{'error-codes'};
99 2         28 return $json->{success};
100             }
101              
102             sub _get_set {
103 38     38   60 my ($self,$name,@args) = @_;
104 38 100       108 $self->{_attrs}->{$name} = $args[0] if (@args);
105 38         124 return $self->{_attrs}->{$name};
106             }
107              
108             1;
109              
110             =head1 NAME
111              
112             Captcha::noCAPTCHA - Simple implementation of Google's noCAPTCHA reCAPTCHA for perl
113              
114             =head1 SYNOPSIS
115              
116             The following is example usage to include captcha in page.
117              
118             my $cap = Captcha::noCAPTCHA->new({site_key => "your site key",secret_key => "your secret key"});
119             my $html = $cap->html;
120              
121             # Include $html in your form page.
122              
123             The following is example usage to verify captcha response.
124              
125              
126             my $cap = Captcha::noCAPTCHA->new({site_key => "your site key",secret_key => "your secret key"});
127             my $cgi = CGI->new;
128             my $captcha_response = $cgi->param('g-recaptcha-response');
129              
130             if ($cap->verify($captcha_response',$cgi->remote_addr)) {
131             # Process the rest of the form.
132             } else {
133             # Tell user he/she needs to prove his/her humanity.
134             }
135              
136             =head1 METHODS
137              
138             =head2 html
139              
140             Accepts no arguments. Returns CAPTCHA html to be rendered with form.
141              
142             =head2 verify($g_captcha_response,$users_ip_address?)
143              
144             Required $g_captcha_response. Input parameter from form containing g_captcha_response
145             Optional $users_ip_address.
146              
147             =head2 errors()
148              
149             Returns an array ref of errors if verify call fails. List of possible errors:
150              
151             missing-input-secret The secret parameter is missing.
152             invalid-input-secret The secret parameter is invalid or malformed.
153             missing-input-response The response parameter is missing.
154             invalid-input-response The response parameter is invalid or malformed.
155             http-tiny-no-response HTTP::Tiny did not return anything. No further information available.
156             status-code-DDD Where DDD is the status code returned from the server.
157             no-content-returned Call was successful, but no content was returned.
158              
159             =head2 response()
160              
161             Returns the response hashref for the most recent captcha response.
162              
163             =head1 FIELD OPTIONS
164              
165             Support for the following field options, over what is inherited from
166             L
167              
168             =head2 site_key
169              
170             Required. The site key you get when you create an account on L
171              
172             =head2 secret_key
173              
174             Required. The secret key you get when you create an account on L
175              
176             =head2 theme
177              
178             Optional. The color theme of the widget. Options are 'light ' or 'dark' (Default: light)
179              
180             =head2 noscript
181              
182             Optional. When true, includes the
183              
184             =head2 api_url
185              
186             Optional. URL to the Google API. Defaults to https://www.google.com/recaptcha/api/siteverify
187              
188             =head2 api_timeout
189              
190             Optional. Seconds to wait for Google API to respond. Default is 10 seconds.
191              
192             =head1 SEE ALSO
193              
194             The following modules or resources may be of interest.
195              
196             L
197              
198             See it in action at L
199              
200             =head1 AUTHOR
201              
202             Chuck Larson C<< >>
203              
204             =head1 CONTRIBUTORS
205              
206             leejo C<< >>
207              
208             =head1 COPYRIGHT & LICENSE
209              
210             Copyright 2015, Chuck Larson C<< >>
211              
212             This projects work sponsered by End Cap Software, LLC.
213             L
214              
215             This program is free software; you can redistribute it and/or modify
216             it under the same terms as Perl itself.
217              
218             =cut