Codebase list libcaptcha-recaptcha-perl / 481af23
[svn-inject] Installing original source of libcaptcha-recaptcha-perl (0.94) Gregor Herrmann 12 years ago
14 changed file(s) with 913 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+47
-0
Changes less more
0 Revision history for Captcha-reCAPTCHA
1
2 0.1 2007-05-25
3 Initial release.
4
5 0.2 2007-05-25
6 Added t/20.check_answer.t, minor doc fixes.
7
8 0.3 2007-05-26
9 Minor doc fixes
10
11 0.4 2007-05-26
12 Made LWP::UserAgent creation lazy
13 Added Mailhide support
14
15 0.5 2007-05-27
16 Added better validation for keys to provide helpful diagnostics in
17 the case where the wrong key is used.
18 Improved test coverage.
19 Added support for generation of RecaptchaOptions options hash.
20
21 0.6 2007-05-29
22 Remove key validation code: keys may change format in the future.
23 Switched server error code to 'recaptcha-not-reachable'
24
25 0.7 2007-05-31
26 Switched to HTML::Tiny for markup generation.
27 Split Captcha::reCAPTCHA::Mailhide into a separate module
28
29 0.8 2007-11-01
30 s/incorrect-challenge-sol/incorrect-captcha-sol/g #29693
31 Thanks to William Campbell for finding it.
32
33 0.9 2007-11-01
34 Code unchanged. Version bump because I packaged the last version
35 with Leopard's tar - which likes to add Apple specific extended
36 attrs. Grrr.
37
38 0.91 2007-11-07
39 Ditched use of version.pm. Sick of version number confusion.
40
41 0.92 2007-11-19
42 Split Captcha::reCAPTCHA::Mailhide into a separate distro so we
43 don't have to depend on Crypt::Rijndael.
44
45 0.93 2010-07-03
46 Updated Perl plugin to use Google infrastructure.
+14
-0
MANIFEST less more
0 Changes
1 examples/captcha.pl
2 lib/Captcha/reCAPTCHA.pm
3 Makefile.PL
4 MANIFEST
5 README
6 t/00.load.t
7 t/10.get_html.t
8 t/20.check_answer.t
9 t/40.errors.t
10 t/pod-coverage.t
11 t/pod.t
12 META.yml Module meta-data (added by MakeMaker)
13 SIGNATURE Public-key signature (added by MakeMaker)
+24
-0
META.yml less more
0 --- #YAML:1.0
1 name: Captcha-reCAPTCHA
2 version: 0.94
3 abstract: A Perl implementation of the reCAPTCHA API
4 author:
5 - Andy Armstrong <andy@hexten.net>
6 license: perl
7 distribution_type: module
8 configure_requires:
9 ExtUtils::MakeMaker: 0
10 build_requires:
11 ExtUtils::MakeMaker: 0
12 requires:
13 HTML::Tiny: 0.904
14 LWP::UserAgent: 0
15 Test::More: 0
16 no_index:
17 directory:
18 - t
19 - inc
20 generated_by: ExtUtils::MakeMaker version 6.56
21 meta-spec:
22 url: http://module-build.sourceforge.net/META-spec-v1.4.html
23 version: 1.4
+22
-0
Makefile.PL less more
0 use strict;
1 use warnings;
2 use ExtUtils::MakeMaker;
3
4 eval 'use ExtUtils::MakeMaker::Coverage';
5
6 WriteMakefile(
7 ( MM->can( 'signature_target' ) ? ( SIGN => 1 ) : () ),
8 NAME => 'Captcha::reCAPTCHA',
9 AUTHOR => 'Andy Armstrong <andy@hexten.net>',
10 LICENSE => 'perl',
11 VERSION_FROM => 'lib/Captcha/reCAPTCHA.pm',
12 ABSTRACT_FROM => 'lib/Captcha/reCAPTCHA.pm',
13 PL_FILES => {},
14 PREREQ_PM => {
15 'Test::More' => 0,
16 'LWP::UserAgent' => 0,
17 'HTML::Tiny' => '0.904',
18 },
19 dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
20 clean => { FILES => 'Captcha-reCAPTCHA-*' },
21 );
+23
-0
README less more
0 Captcha-reCAPTCHA version 0.93
1
2 INSTALLATION
3
4 To install this module, run the following commands:
5
6 perl Makefile.PL
7 make
8 make test
9 make install
10
11
12 DEPENDENCIES
13
14 LWP::UserAgent
15 HTML::Tiny
16
17 COPYRIGHT AND LICENCE
18
19 Copyright (C) 2007, Andy Armstrong
20
21 This library is free software; you can redistribute it and/or modify
22 it under the same terms as Perl itself.
+36
-0
SIGNATURE less more
0 This file contains message digests of all files listed in MANIFEST,
1 signed via the Module::Signature module, version 0.64.
2
3 To verify the content in this distribution, first make sure you have
4 Module::Signature installed, then type:
5
6 % cpansign -v
7
8 It will check each file's integrity, as well as the signature's
9 validity. If "==> Signature verified OK! <==" is not displayed,
10 the distribution may already have been compromised, and you should
11 not run its Makefile.PL or Build.PL.
12
13 -----BEGIN PGP SIGNED MESSAGE-----
14 Hash: SHA1
15
16 SHA1 9be42ea49f30d62235ff86789df20a42bdb9fab0 Changes
17 SHA1 e2ed71890f1f07d86b1e877bd6b33a856cf0ef4c MANIFEST
18 SHA1 b2c7153f65c4d5bd2e898381a86ea5eeeae3bc5e META.yml
19 SHA1 334033f6e4a65e1d87f8e07d810416b7dad3457d Makefile.PL
20 SHA1 51f95b312f1ec74f565588a929c5acb7fbbe0605 README
21 SHA1 8698ba348a5fa7cb01cc99eda007d3500e45706c examples/captcha.pl
22 SHA1 e0cd4fddaf7e5b27bb808bc61b130c0b5792bda2 lib/Captcha/reCAPTCHA.pm
23 SHA1 9f9bc14f8a6332889679c48a8c697a7fcea55a8a t/00.load.t
24 SHA1 e4246491168fad2823ea2f199a42377d63454da5 t/10.get_html.t
25 SHA1 ccbe936829f91b67c3b10d239d9108b88cc6aa37 t/20.check_answer.t
26 SHA1 4d63f3b02bd00e1b7ad062c4f7f384bb71f6112a t/40.errors.t
27 SHA1 aeaa691851a425f07ab6a8d4f825e2ad9d92b8ee t/pod-coverage.t
28 SHA1 0190346d7072d458c8a10a45c19f86db641dcc48 t/pod.t
29 -----BEGIN PGP SIGNATURE-----
30 Version: GnuPG v1.4.10 (Darwin)
31
32 iEYEARECAAYFAkwvP6EACgkQwoknRJZQnCE2fwCcDz49vWj+QZGhnd1GEyGGzNb2
33 bXwAnjNS1hyHktvrqbm2I9ZshdxC3ERg
34 =3LxA
35 -----END PGP SIGNATURE-----
+53
-0
examples/captcha.pl less more
0 #!/usr/bin/perl
1 # Simple CGI Captcha
2
3 use strict;
4 use warnings;
5 use Captcha::reCAPTCHA;
6 use CGI::Simple;
7
8 # Your reCAPTCHA keys from
9 # https://www.google.com/recaptcha/admin/create
10 use constant PUBLIC_KEY => '<public key here>';
11 use constant PRIVATE_KEY => '<private key here>';
12
13 $| = 1;
14
15 my $q = CGI::Simple->new;
16 my $c = Captcha::reCAPTCHA->new;
17
18 my $error = undef;
19
20 print "Content-type: text/html\n\n";
21 print <<EOT;
22 <html>
23 <body>
24 <form action="" method="post">
25 EOT
26
27 # Check response
28 if ( $q->param( 'recaptcha_response_field' ) ) {
29 my $result = $c->check_answer(
30 PRIVATE_KEY, $ENV{'REMOTE_ADDR'},
31 $q->param( 'recaptcha_challenge_field' ),
32 $q->param( 'recaptcha_response_field' )
33 );
34
35 if ( $result->{is_valid} ) {
36 print "Yes!";
37 }
38 else {
39 $error = $result->{error};
40 }
41 }
42
43 # Generate the form
44 print $c->get_html( PUBLIC_KEY, $error );
45
46 print <<EOT;
47 <br/>
48 <input type="submit" value="submit" />
49 </form>
50 </body>
51 </html>
52 EOT
+393
-0
lib/Captcha/reCAPTCHA.pm less more
0 package Captcha::reCAPTCHA;
1
2 use warnings;
3 use strict;
4 use Carp;
5 use LWP::UserAgent;
6 use HTML::Tiny;
7
8 our $VERSION = '0.93';
9
10 use constant API_SERVER => 'http://www.google.com/recaptcha/api';
11 use constant API_SECURE_SERVER =>
12 'https://www.google.com/recaptcha/api';
13 use constant API_VERIFY_SERVER => 'http://www.google.com';
14 use constant SERVER_ERROR => 'recaptcha-not-reachable';
15
16 sub new {
17 my $class = shift;
18 my $self = bless {}, $class;
19 $self->_initialize( @_ );
20 return $self;
21 }
22
23 sub _initialize {
24 my $self = shift;
25 my $args = shift || {};
26
27 croak "new must be called with a reference to a hash of parameters"
28 unless 'HASH' eq ref $args;
29 }
30
31 sub _html { shift->{_html} ||= HTML::Tiny->new }
32
33 sub get_options_setter {
34 my $self = shift;
35 my $options = shift || return '';
36
37 croak "The argument to get_options_setter must be a hashref"
38 unless 'HASH' eq ref $options;
39
40 my $h = $self->_html;
41
42 return $h->script(
43 { type => 'text/javascript' },
44 "\n//<![CDATA[\n"
45 . "var RecaptchaOptions = "
46 . $h->json_encode( $options )
47 . ";\n//]]>\n"
48 ) . "\n";
49 }
50
51 sub get_html {
52 my $self = shift;
53 my ( $pubkey, $error, $use_ssl, $options ) = @_;
54
55 croak
56 "To use reCAPTCHA you must get an API key from https://www.google.com/recaptcha/admin/create"
57 unless $pubkey;
58
59 my $h = $self->_html;
60 my $server = $use_ssl ? API_SECURE_SERVER : API_SERVER;
61
62 my $query = { k => $pubkey };
63 if ( $error ) {
64 # Handle the case where the result hash from check_answer
65 # is passed.
66 if ( 'HASH' eq ref $error ) {
67 return '' if $error->{is_valid};
68 $error = $error->{error};
69 }
70 $query->{error} = $error;
71 }
72 my $qs = $h->query_encode( $query );
73
74 return join(
75 '',
76 $self->get_options_setter( $options ),
77 $h->script(
78 {
79 type => 'text/javascript',
80 src => "$server/challenge?$qs",
81 }
82 ),
83 "\n",
84 $h->noscript(
85 [
86 $h->iframe(
87 {
88 src => "$server/noscript?$qs",
89 height => 300,
90 width => 500,
91 frameborder => 0
92 }
93 ),
94 $h->textarea(
95 {
96 name => 'recaptcha_challenge_field',
97 rows => 3,
98 cols => 40
99 }
100 ),
101 $h->input(
102 {
103 type => 'hidden',
104 name => 'recaptcha_response_field',
105 value => 'manual_challenge'
106 }
107 )
108 ]
109 ),
110 "\n"
111 );
112 }
113
114 sub _post_request {
115 my $self = shift;
116 my ( $url, $args ) = @_;
117
118 my $ua = LWP::UserAgent->new();
119 return $ua->post( $url, $args );
120 }
121
122 sub check_answer {
123 my $self = shift;
124 my ( $privkey, $remoteip, $challenge, $response ) = @_;
125
126 croak
127 "To use reCAPTCHA you must get an API key from https://www.google.com/recaptcha/admin/create"
128 unless $privkey;
129
130 croak "For security reasons, you must pass the remote ip to reCAPTCHA"
131 unless $remoteip;
132
133 return { is_valid => 0, error => 'incorrect-captcha-sol' }
134 unless $challenge && $response;
135
136 my $resp = $self->_post_request(
137 API_VERIFY_SERVER . '/recaptcha/api/verify',
138 {
139 privatekey => $privkey,
140 remoteip => $remoteip,
141 challenge => $challenge,
142 response => $response
143 }
144 );
145
146 if ( $resp->is_success ) {
147 my ( $answer, $message ) = split( /\n/, $resp->content, 2 );
148 if ( $answer =~ /true/ ) {
149 return { is_valid => 1 };
150 }
151 else {
152 chomp $message;
153 return { is_valid => 0, error => $message };
154 }
155 }
156 else {
157 return { is_valid => 0, error => SERVER_ERROR };
158 }
159 }
160
161 1;
162 __END__
163
164 =head1 NAME
165
166 Captcha::reCAPTCHA - A Perl implementation of the reCAPTCHA API
167
168 =head1 VERSION
169
170 This document describes Captcha::reCAPTCHA version 0.93
171
172 =head1 SYNOPSIS
173
174 use Captcha::reCAPTCHA;
175
176 my $c = Captcha::reCAPTCHA->new;
177
178 # Output form
179 print $c->get_html( 'your public key here' );
180
181 # Verify submission
182 my $result = $c->check_answer(
183 'your private key here', $ENV{'REMOTE_ADDR'},
184 $challenge, $response
185 );
186
187 if ( $result->{is_valid} ) {
188 print "Yes!";
189 }
190 else {
191 # Error
192 $error = $result->{error};
193 }
194
195 For complete examples see the /examples subdirectory
196
197 =head1 DESCRIPTION
198
199 reCAPTCHA is a hybrid mechanical turk and captcha that allows visitors
200 who complete the captcha to assist in the digitization of books.
201
202 From L<http://recaptcha.net/learnmore.html>:
203
204 reCAPTCHA improves the process of digitizing books by sending words that
205 cannot be read by computers to the Web in the form of CAPTCHAs for
206 humans to decipher. More specifically, each word that cannot be read
207 correctly by OCR is placed on an image and used as a CAPTCHA. This is
208 possible because most OCR programs alert you when a word cannot be read
209 correctly.
210
211 This Perl implementation is modelled on the PHP interface that can be
212 found here:
213
214 L<http://recaptcha.net/plugins/php/>
215
216 To use reCAPTCHA you need to register your site here:
217
218 L<https://www.google.com/recaptcha/admin/create>
219
220 =head1 INTERFACE
221
222 =over
223
224 =item C<< new >>
225
226 Create a new C<< Captcha::reCAPTCHA >>.
227
228 =item C<< get_html( $pubkey, $error, $use_ssl, $options ) >>
229
230 Generates HTML to display the captcha.
231
232 print $captcha->get_html( $PUB, $err );
233
234 =over
235
236 =item C<< $pubkey >>
237
238 Your reCAPTCHA public key, from the API Signup Page
239
240 =item C<< $error >>
241
242 Optional. If set this should be either a string containing a reCAPTCHA
243 status code or a result hash as returned by C<< check_answer >>.
244
245 =item C<< $use_ssl >>
246
247 Optional. Should the SSL-based API be used? If you are displaying a page
248 to the user over SSL, be sure to set this to true so an error dialog
249 doesn't come up in the user's browser.
250
251 =item C<< $options >>
252
253 Optional. A reference to a hash of options for the captcha. See
254 C<< get_options_setter >> for more details.
255
256 =back
257
258 Returns a string containing the HTML that should be used to display
259 the captcha.
260
261 =item C<< get_options_setter( $options ) >>
262
263 You can optionally customize the look of the reCAPTCHA widget with some
264 JavaScript settings. C<get_options_setter> returns a block of Javascript
265 wrapped in <script> .. </script> tags that will set the options to be used
266 by the widget.
267
268 C<$options> is a reference to a hash that may contain the following keys:
269
270 =over
271
272 =item C<theme>
273
274 Defines which theme to use for reCAPTCHA. Possible values are 'red',
275 'white' or 'blackglass'. The default is 'red'.
276
277 =item C<tabindex>
278
279 Sets a tabindex for the reCAPTCHA text box. If other elements in the
280 form use a tabindex, this should be set so that navigation is easier for
281 the user. Default: 0.
282
283 =back
284
285 =item C<< check_answer >>
286
287 After the user has filled out the HTML form, including their answer for
288 the CAPTCHA, use C<< check_answer >> to check their answer when they
289 submit the form. The user's answer will be in two form fields,
290 recaptcha_challenge_field and recaptcha_response_field. The reCAPTCHA
291 library will make an HTTP request to the reCAPTCHA server and verify the
292 user's answer.
293
294 =over
295
296 =item C<< $privkey >>
297
298 Your reCAPTCHA private key, from the API Signup Page.
299
300 =item C<< $remoteip >>
301
302 The user's IP address, in the format 192.168.0.1.
303
304 =item C<< $challenge >>
305
306 The value of the form field recaptcha_challenge_field
307
308 =item C<< $response >>
309
310 The value of the form field recaptcha_response_field.
311
312 =back
313
314 Returns a reference to a hash containing two fields: C<is_valid>
315 and C<error>.
316
317 my $result = $c->check_answer(
318 'your private key here', $ENV{'REMOTE_ADDR'},
319 $challenge, $response
320 );
321
322 if ( $result->{is_valid} ) {
323 print "Yes!";
324 }
325 else {
326 # Error
327 $error = $result->{error};
328 }
329
330 See the /examples subdirectory for examples of how to call C<check_answer>.
331
332 =back
333
334 =head1 CONFIGURATION AND ENVIRONMENT
335
336 Captcha::reCAPTCHA requires no configuration files or environment
337 variables.
338
339 To use reCAPTCHA sign up for a key pair here:
340
341 L<https://www.google.com/recaptcha/admin/create>
342
343 =head1 DEPENDENCIES
344
345 LWP::UserAgent,
346 HTML::Tiny
347
348 =head1 INCOMPATIBILITIES
349
350 None reported .
351
352 =head1 BUGS AND LIMITATIONS
353
354 No bugs have been reported.
355
356 Please report any bugs or feature requests to
357 C<bug-captcha-recaptcha@rt.cpan.org>, or through the web interface at
358 L<http://rt.cpan.org>.
359
360 =head1 AUTHOR
361
362 Andy Armstrong C<< <andy@hexten.net> >>
363
364 =head1 LICENCE AND COPYRIGHT
365
366 Copyright (c) 2007, Andy Armstrong C<< <andy@hexten.net> >>. All rights reserved.
367
368 This module is free software; you can redistribute it and/or
369 modify it under the same terms as Perl itself. See L<perlartistic>.
370
371 =head1 DISCLAIMER OF WARRANTY
372
373 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
374 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
375 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
376 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
377 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
378 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
379 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
380 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
381 NECESSARY SERVICING, REPAIR, OR CORRECTION.
382
383 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
384 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
385 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
386 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
387 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
388 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
389 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
390 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
391 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
392 SUCH DAMAGES.
+7
-0
t/00.load.t less more
0 use Test::More tests => 1;
1
2 BEGIN {
3 use_ok( 'Captcha::reCAPTCHA' );
4 }
5
6 diag( "Testing Captcha::reCAPTCHA $Captcha::reCAPTCHA::VERSION" );
+90
-0
t/10.get_html.t less more
0 use strict;
1 use warnings;
2 use Test::More;
3 use Captcha::reCAPTCHA;
4
5 # Looks real. Isn't.
6 use constant PUBKEY => '6LdAAAkAwAAAFJj6ACG3Wlix_GuQJMNGjMQnw5UY';
7
8 my @schedule;
9
10 BEGIN {
11 my $pubkey = PUBKEY;
12
13 @schedule = (
14 {
15 name => 'Simple',
16 args => [$pubkey],
17 expect =>
18 qq{<script src="http://www.google.com/recaptcha/api/challenge?k=$pubkey" }
19 . qq{type="text/javascript"></script>\n}
20 . qq{<noscript><iframe frameborder="0" height="300" }
21 . qq{src="http://www.google.com/recaptcha/api/noscript?k=$pubkey" }
22 . qq{width="500"></iframe><textarea cols="40" name="recaptcha_challenge_field" }
23 . qq{rows="3"></textarea><input name="recaptcha_response_field" type="hidden" }
24 . qq{value="manual_challenge" /></noscript>\n}
25 },
26 {
27 name => 'Error',
28 args => [ $pubkey, '<<some random error>>' ],
29 expect =>
30 qq{<script src="http://www.google.com/recaptcha/api/challenge?error=%3c%3csome+random+error%3e%3e&amp;k=$pubkey" }
31 . qq{type="text/javascript"></script>\n}
32 . qq{<noscript><iframe frameborder="0" height="300" }
33 . qq{src="http://www.google.com/recaptcha/api/noscript?error=%3c%3csome+random+error%3e%3e&amp;k=$pubkey" }
34 . qq{width="500"></iframe><textarea cols="40" name="recaptcha_challenge_field" }
35 . qq{rows="3"></textarea><input name="recaptcha_response_field" type="hidden" }
36 . qq{value="manual_challenge" /></noscript>\n}
37 },
38 {
39 name => 'Error in hash',
40 args =>
41 [ $pubkey, { is_valid => 0, error => '<<some random error>>' } ],
42 expect =>
43 qq{<script src="http://www.google.com/recaptcha/api/challenge?error=%3c%3csome+random+error%3e%3e&amp;k=$pubkey" }
44 . qq{type="text/javascript"></script>\n}
45 . qq{<noscript><iframe frameborder="0" height="300" }
46 . qq{src="http://www.google.com/recaptcha/api/noscript?error=%3c%3csome+random+error%3e%3e&amp;k=$pubkey" }
47 . qq{width="500"></iframe><textarea cols="40" name="recaptcha_challenge_field" }
48 . qq{rows="3"></textarea><input name="recaptcha_response_field" type="hidden" }
49 . qq{value="manual_challenge" /></noscript>\n}
50 },
51 {
52 name => 'Secure',
53 args => [ $pubkey, undef, 1 ],
54 expect =>
55 qq{<script src="https://www.google.com/recaptcha/api/challenge?k=$pubkey" }
56 . qq{type="text/javascript"></script>\n}
57 . qq{<noscript><iframe frameborder="0" height="300" }
58 . qq{src="https://www.google.com/recaptcha/api/noscript?k=$pubkey" }
59 . qq{width="500"></iframe><textarea cols="40" name="recaptcha_challenge_field" }
60 . qq{rows="3"></textarea><input name="recaptcha_response_field" type="hidden" }
61 . qq{value="manual_challenge" /></noscript>\n}
62 },
63 {
64 name => 'Options',
65 args =>
66 [ $pubkey, undef, 0, { theme => 'white', tabindex => 3 } ],
67 expect =>
68 qq(<script type="text/javascript">\n//<![CDATA[\nvar RecaptchaOptions = )
69 . qq({"tabindex":3,"theme":"white"};\n//]]>\n</script>\n)
70 . qq{<script src="http://www.google.com/recaptcha/api/challenge?k=$pubkey" }
71 . qq{type="text/javascript"></script>\n}
72 . qq{<noscript><iframe frameborder="0" height="300" }
73 . qq{src="http://www.google.com/recaptcha/api/noscript?k=$pubkey" }
74 . qq{width="500"></iframe><textarea cols="40" name="recaptcha_challenge_field" }
75 . qq{rows="3"></textarea><input name="recaptcha_response_field" type="hidden" }
76 . qq{value="manual_challenge" /></noscript>\n}
77 },
78 );
79 plan tests => 3 * @schedule;
80 }
81
82 for my $test ( @schedule ) {
83 my $name = $test->{name};
84 ok my $captcha = Captcha::reCAPTCHA->new(), "$name: Created OK";
85 isa_ok $captcha, 'Captcha::reCAPTCHA';
86 my $args = $test->{args};
87 my $html = $captcha->get_html( @$args );
88 is $html, $test->{expect}, "$name: Generate HTML OK";
89 }
+92
-0
t/20.check_answer.t less more
0 use strict;
1 use warnings;
2 use Test::More;
3 use HTTP::Response;
4 use Captcha::reCAPTCHA;
5 use Data::Dumper;
6
7 # Looks real. Isn't.
8 use constant PRIVKEY => '6LdAAAkAwAAAix_GF6AMQnw5UCG3JjWluQJMNGjY';
9
10 my @schedule;
11
12 BEGIN {
13
14 # Looks real. Isn't.
15 @schedule = (
16 {
17 name => 'Simple correct',
18 args =>
19 [ PRIVKEY, '192.168.0.1', '..challenge..', '..response..' ],
20 response => "true\n",
21 check_args => {
22 privatekey => PRIVKEY,
23 remoteip => '192.168.0.1',
24 challenge => '..challenge..',
25 response => '..response..'
26 },
27 check_url => 'http://www.google.com/recaptcha/api/verify',
28 expect => { is_valid => 1 },
29 },
30 {
31 name => 'Simple incorrect',
32 args =>
33 [ PRIVKEY, '192.168.0.1', '..challenge..', '..response..' ],
34 response => "false\nincorrect-captcha-sol\n",
35 check_args => {
36 privatekey => PRIVKEY,
37 remoteip => '192.168.0.1',
38 challenge => '..challenge..',
39 response => '..response..'
40 },
41 check_url => 'http://www.google.com/recaptcha/api/verify',
42 expect => { is_valid => 0, error => 'incorrect-captcha-sol' },
43 },
44 );
45 plan tests => 6 * @schedule;
46 }
47
48 package T::Captcha::reCAPTCHA;
49
50 our @ISA = qw(Captcha::reCAPTCHA);
51 use Captcha::reCAPTCHA;
52
53 sub set_response {
54 my $self = shift;
55 my $response = shift;
56 $self->{t_response} = $response;
57 }
58
59 sub _post_request {
60 my $self = shift;
61 my $url = shift;
62 my $args = shift;
63
64 # Just keep the args
65 $self->{t_url} = $url;
66 $self->{t_args} = $args;
67
68 return HTTP::Response->new( 200, 'OK',
69 [ 'Content-type:' => 'text/plain' ],
70 $self->{t_response} );
71 }
72
73 sub get_url { shift->{t_url} }
74 sub get_args { shift->{t_args} }
75
76 package main;
77
78 for my $test ( @schedule ) {
79 my $name = $test->{name};
80 ok my $captcha = T::Captcha::reCAPTCHA->new(), "$name: Created OK";
81 isa_ok $captcha, 'Captcha::reCAPTCHA';
82 $captcha->set_response( $test->{response} );
83 ok my $resp = $captcha->check_answer( @{ $test->{args} } ),
84 "$name: got response";
85 is $captcha->get_url, $test->{check_url}, "$name: URL OK";
86 is_deeply $captcha->get_args, $test->{check_args}, "$name: args OK";
87 unless ( is_deeply $resp, $test->{expect}, "$name: result OK" ) {
88 diag( Data::Dumper->Dump( [ $test->{expect} ], ['$expected'] ) );
89 diag( Data::Dumper->Dump( [$resp], ['$got'] ) );
90 }
91 }
+97
-0
t/40.errors.t less more
0 use strict;
1 use warnings;
2 use Test::More;
3 use Captcha::reCAPTCHA;
4
5 use constant PUBKEY => '6LdAAAkAwAAAFJj6ACG3Wlix_GuQJMNGjMQnw5UY';
6 use constant PRIVKEY => '6LdAAAkAwAAAix_GF6AMQnw5UCG3JjWluQJMNGjY';
7
8 my @schedule;
9
10 BEGIN {
11 @schedule = (
12 {
13 name => 'new: Bad args',
14 class => 'T::Captcha::reCAPTCHA',
15 try => sub {
16 my $c = Captcha::reCAPTCHA->new( PUBKEY );
17 },
18 expect => qr/reference to a hash/
19 },
20 {
21 name => 'get_html: No args',
22 class => 'T::Captcha::reCAPTCHA',
23 try => sub {
24 my $c = shift;
25 $c->get_html();
26 },
27 expect => qr/To use reCAPTCHA you must get an API key from/
28 },
29 {
30 name => 'get_html: No key',
31 class => 'T::Captcha::reCAPTCHA',
32 try => sub {
33 my $c = shift;
34 $c->get_html( '' );
35 },
36 expect => qr/To use reCAPTCHA you must get an API key from/
37 },
38 {
39 name => 'check_answer: No args',
40 class => 'T::Captcha::reCAPTCHA',
41 try => sub {
42 my $c = shift;
43 $c->check_answer();
44 },
45 expect => qr/To use reCAPTCHA you must get an API key from/
46 },
47 {
48 name => 'check_answer: no ip',
49 class => 'T::Captcha::reCAPTCHA',
50 try => sub {
51 my $c = shift;
52 $c->check_answer( PRIVKEY );
53 },
54 expect => qr/you must pass the remote ip/
55 },
56 );
57
58 plan tests => 3 * @schedule;
59 }
60
61 package T::Captcha::reCAPTCHA;
62
63 our @ISA = qw(Captcha::reCAPTCHA);
64 use Captcha::reCAPTCHA;
65
66 sub _post_request {
67 my $self = shift;
68 my $url = shift;
69 my $args = shift;
70
71 # Just keep the args
72 $self->{t_url} = $url;
73 $self->{t_args} = $args;
74
75 return HTTP::Response->new( 200, 'OK',
76 [ 'Content-type:' => 'text/plain' ], "true\n" );
77 }
78
79 sub get_url { shift->{t_url} }
80 sub get_args { shift->{t_args} }
81
82 package main;
83
84 for my $test ( @schedule ) {
85 my $name = $test->{name};
86 my $class = $test->{class};
87 ok my $captcha = $class->new, "$name: create OK";
88 isa_ok $captcha, $class;
89 eval { $test->{try}->( $captcha ); };
90 if ( my $expect = $test->{expect} ) {
91 like $@, $expect, "$name: error OK";
92 }
93 else {
94 ok !$@, "$name: no error OK";
95 }
96 }
+9
-0
t/pod-coverage.t less more
0 #!perl -T
1
2 use Test::More;
3 eval "use Test::Pod::Coverage 1.04";
4 plan skip_all =>
5 "Test::Pod::Coverage 1.04 required for testing POD coverage"
6 if $@;
7 all_pod_coverage_ok(
8 { private => [ qr{^BUILD|DEMOLISH|AUTOMETHOD|START$}, qr{^_} ] } );
+6
-0
t/pod.t less more
0 #!perl -T
1
2 use Test::More;
3 eval "use Test::Pod 1.14";
4 plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
5 all_pod_files_ok();