r74531 - in /branches/upstream/libcaptcha-recaptcha-perl: ./ current/ current/examples/ current/lib/ current/lib/Captcha/ current/t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Mon May 16 19:19:18 UTC 2011
Author: gregoa
Date: Mon May 16 19:18:54 2011
New Revision: 74531
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=74531
Log:
[svn-inject] Installing original source of libcaptcha-recaptcha-perl (0.94)
Added:
branches/upstream/libcaptcha-recaptcha-perl/
branches/upstream/libcaptcha-recaptcha-perl/current/
branches/upstream/libcaptcha-recaptcha-perl/current/Changes
branches/upstream/libcaptcha-recaptcha-perl/current/MANIFEST
branches/upstream/libcaptcha-recaptcha-perl/current/META.yml
branches/upstream/libcaptcha-recaptcha-perl/current/Makefile.PL
branches/upstream/libcaptcha-recaptcha-perl/current/README
branches/upstream/libcaptcha-recaptcha-perl/current/SIGNATURE
branches/upstream/libcaptcha-recaptcha-perl/current/examples/
branches/upstream/libcaptcha-recaptcha-perl/current/examples/captcha.pl (with props)
branches/upstream/libcaptcha-recaptcha-perl/current/lib/
branches/upstream/libcaptcha-recaptcha-perl/current/lib/Captcha/
branches/upstream/libcaptcha-recaptcha-perl/current/lib/Captcha/reCAPTCHA.pm
branches/upstream/libcaptcha-recaptcha-perl/current/t/
branches/upstream/libcaptcha-recaptcha-perl/current/t/00.load.t
branches/upstream/libcaptcha-recaptcha-perl/current/t/10.get_html.t
branches/upstream/libcaptcha-recaptcha-perl/current/t/20.check_answer.t
branches/upstream/libcaptcha-recaptcha-perl/current/t/40.errors.t
branches/upstream/libcaptcha-recaptcha-perl/current/t/pod-coverage.t
branches/upstream/libcaptcha-recaptcha-perl/current/t/pod.t
Added: branches/upstream/libcaptcha-recaptcha-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/Changes?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/Changes (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/Changes Mon May 16 19:18:54 2011
@@ -1,0 +1,47 @@
+Revision history for Captcha-reCAPTCHA
+
+0.1 2007-05-25
+ Initial release.
+
+0.2 2007-05-25
+ Added t/20.check_answer.t, minor doc fixes.
+
+0.3 2007-05-26
+ Minor doc fixes
+
+0.4 2007-05-26
+ Made LWP::UserAgent creation lazy
+ Added Mailhide support
+
+0.5 2007-05-27
+ Added better validation for keys to provide helpful diagnostics in
+ the case where the wrong key is used.
+ Improved test coverage.
+ Added support for generation of RecaptchaOptions options hash.
+
+0.6 2007-05-29
+ Remove key validation code: keys may change format in the future.
+ Switched server error code to 'recaptcha-not-reachable'
+
+0.7 2007-05-31
+ Switched to HTML::Tiny for markup generation.
+ Split Captcha::reCAPTCHA::Mailhide into a separate module
+
+0.8 2007-11-01
+ s/incorrect-challenge-sol/incorrect-captcha-sol/g #29693
+ Thanks to William Campbell for finding it.
+
+0.9 2007-11-01
+ Code unchanged. Version bump because I packaged the last version
+ with Leopard's tar - which likes to add Apple specific extended
+ attrs. Grrr.
+
+0.91 2007-11-07
+ Ditched use of version.pm. Sick of version number confusion.
+
+0.92 2007-11-19
+ Split Captcha::reCAPTCHA::Mailhide into a separate distro so we
+ don't have to depend on Crypt::Rijndael.
+
+0.93 2010-07-03
+ Updated Perl plugin to use Google infrastructure.
Added: branches/upstream/libcaptcha-recaptcha-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/MANIFEST?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/MANIFEST (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/MANIFEST Mon May 16 19:18:54 2011
@@ -1,0 +1,14 @@
+Changes
+examples/captcha.pl
+lib/Captcha/reCAPTCHA.pm
+Makefile.PL
+MANIFEST
+README
+t/00.load.t
+t/10.get_html.t
+t/20.check_answer.t
+t/40.errors.t
+t/pod-coverage.t
+t/pod.t
+META.yml Module meta-data (added by MakeMaker)
+SIGNATURE Public-key signature (added by MakeMaker)
Added: branches/upstream/libcaptcha-recaptcha-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/META.yml?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/META.yml (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/META.yml Mon May 16 19:18:54 2011
@@ -1,0 +1,24 @@
+--- #YAML:1.0
+name: Captcha-reCAPTCHA
+version: 0.94
+abstract: A Perl implementation of the reCAPTCHA API
+author:
+ - Andy Armstrong <andy at hexten.net>
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ HTML::Tiny: 0.904
+ LWP::UserAgent: 0
+ Test::More: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.56
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Added: branches/upstream/libcaptcha-recaptcha-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/Makefile.PL?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/Makefile.PL (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/Makefile.PL Mon May 16 19:18:54 2011
@@ -1,0 +1,22 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+eval 'use ExtUtils::MakeMaker::Coverage';
+
+WriteMakefile(
+ ( MM->can( 'signature_target' ) ? ( SIGN => 1 ) : () ),
+ NAME => 'Captcha::reCAPTCHA',
+ AUTHOR => 'Andy Armstrong <andy at hexten.net>',
+ LICENSE => 'perl',
+ VERSION_FROM => 'lib/Captcha/reCAPTCHA.pm',
+ ABSTRACT_FROM => 'lib/Captcha/reCAPTCHA.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'LWP::UserAgent' => 0,
+ 'HTML::Tiny' => '0.904',
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'Captcha-reCAPTCHA-*' },
+);
Added: branches/upstream/libcaptcha-recaptcha-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/README?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/README (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/README Mon May 16 19:18:54 2011
@@ -1,0 +1,23 @@
+Captcha-reCAPTCHA version 0.93
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+DEPENDENCIES
+
+LWP::UserAgent
+HTML::Tiny
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007, Andy Armstrong
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
Added: branches/upstream/libcaptcha-recaptcha-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/SIGNATURE?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/SIGNATURE (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/SIGNATURE Mon May 16 19:18:54 2011
@@ -1,0 +1,36 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.64.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+ % cpansign -v
+
+It will check each file's integrity, as well as the signature's
+validity. If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 9be42ea49f30d62235ff86789df20a42bdb9fab0 Changes
+SHA1 e2ed71890f1f07d86b1e877bd6b33a856cf0ef4c MANIFEST
+SHA1 b2c7153f65c4d5bd2e898381a86ea5eeeae3bc5e META.yml
+SHA1 334033f6e4a65e1d87f8e07d810416b7dad3457d Makefile.PL
+SHA1 51f95b312f1ec74f565588a929c5acb7fbbe0605 README
+SHA1 8698ba348a5fa7cb01cc99eda007d3500e45706c examples/captcha.pl
+SHA1 e0cd4fddaf7e5b27bb808bc61b130c0b5792bda2 lib/Captcha/reCAPTCHA.pm
+SHA1 9f9bc14f8a6332889679c48a8c697a7fcea55a8a t/00.load.t
+SHA1 e4246491168fad2823ea2f199a42377d63454da5 t/10.get_html.t
+SHA1 ccbe936829f91b67c3b10d239d9108b88cc6aa37 t/20.check_answer.t
+SHA1 4d63f3b02bd00e1b7ad062c4f7f384bb71f6112a t/40.errors.t
+SHA1 aeaa691851a425f07ab6a8d4f825e2ad9d92b8ee t/pod-coverage.t
+SHA1 0190346d7072d458c8a10a45c19f86db641dcc48 t/pod.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.10 (Darwin)
+
+iEYEARECAAYFAkwvP6EACgkQwoknRJZQnCE2fwCcDz49vWj+QZGhnd1GEyGGzNb2
+bXwAnjNS1hyHktvrqbm2I9ZshdxC3ERg
+=3LxA
+-----END PGP SIGNATURE-----
Added: branches/upstream/libcaptcha-recaptcha-perl/current/examples/captcha.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/examples/captcha.pl?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/examples/captcha.pl (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/examples/captcha.pl Mon May 16 19:18:54 2011
@@ -1,0 +1,53 @@
+#!/usr/bin/perl
+# Simple CGI Captcha
+
+use strict;
+use warnings;
+use Captcha::reCAPTCHA;
+use CGI::Simple;
+
+# Your reCAPTCHA keys from
+# https://www.google.com/recaptcha/admin/create
+use constant PUBLIC_KEY => '<public key here>';
+use constant PRIVATE_KEY => '<private key here>';
+
+$| = 1;
+
+my $q = CGI::Simple->new;
+my $c = Captcha::reCAPTCHA->new;
+
+my $error = undef;
+
+print "Content-type: text/html\n\n";
+print <<EOT;
+<html>
+ <body>
+ <form action="" method="post">
+EOT
+
+# Check response
+if ( $q->param( 'recaptcha_response_field' ) ) {
+ my $result = $c->check_answer(
+ PRIVATE_KEY, $ENV{'REMOTE_ADDR'},
+ $q->param( 'recaptcha_challenge_field' ),
+ $q->param( 'recaptcha_response_field' )
+ );
+
+ if ( $result->{is_valid} ) {
+ print "Yes!";
+ }
+ else {
+ $error = $result->{error};
+ }
+}
+
+# Generate the form
+print $c->get_html( PUBLIC_KEY, $error );
+
+print <<EOT;
+ <br/>
+ <input type="submit" value="submit" />
+ </form>
+ </body>
+</html>
+EOT
Propchange: branches/upstream/libcaptcha-recaptcha-perl/current/examples/captcha.pl
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libcaptcha-recaptcha-perl/current/lib/Captcha/reCAPTCHA.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/lib/Captcha/reCAPTCHA.pm?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/lib/Captcha/reCAPTCHA.pm (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/lib/Captcha/reCAPTCHA.pm Mon May 16 19:18:54 2011
@@ -1,0 +1,393 @@
+package Captcha::reCAPTCHA;
+
+use warnings;
+use strict;
+use Carp;
+use LWP::UserAgent;
+use HTML::Tiny;
+
+our $VERSION = '0.93';
+
+use constant API_SERVER => 'http://www.google.com/recaptcha/api';
+use constant API_SECURE_SERVER =>
+ 'https://www.google.com/recaptcha/api';
+use constant API_VERIFY_SERVER => 'http://www.google.com';
+use constant SERVER_ERROR => 'recaptcha-not-reachable';
+
+sub new {
+ my $class = shift;
+ my $self = bless {}, $class;
+ $self->_initialize( @_ );
+ return $self;
+}
+
+sub _initialize {
+ my $self = shift;
+ my $args = shift || {};
+
+ croak "new must be called with a reference to a hash of parameters"
+ unless 'HASH' eq ref $args;
+}
+
+sub _html { shift->{_html} ||= HTML::Tiny->new }
+
+sub get_options_setter {
+ my $self = shift;
+ my $options = shift || return '';
+
+ croak "The argument to get_options_setter must be a hashref"
+ unless 'HASH' eq ref $options;
+
+ my $h = $self->_html;
+
+ return $h->script(
+ { type => 'text/javascript' },
+ "\n//<![CDATA[\n"
+ . "var RecaptchaOptions = "
+ . $h->json_encode( $options )
+ . ";\n//]]>\n"
+ ) . "\n";
+}
+
+sub get_html {
+ my $self = shift;
+ my ( $pubkey, $error, $use_ssl, $options ) = @_;
+
+ croak
+ "To use reCAPTCHA you must get an API key from https://www.google.com/recaptcha/admin/create"
+ unless $pubkey;
+
+ my $h = $self->_html;
+ my $server = $use_ssl ? API_SECURE_SERVER : API_SERVER;
+
+ my $query = { k => $pubkey };
+ if ( $error ) {
+ # Handle the case where the result hash from check_answer
+ # is passed.
+ if ( 'HASH' eq ref $error ) {
+ return '' if $error->{is_valid};
+ $error = $error->{error};
+ }
+ $query->{error} = $error;
+ }
+ my $qs = $h->query_encode( $query );
+
+ return join(
+ '',
+ $self->get_options_setter( $options ),
+ $h->script(
+ {
+ type => 'text/javascript',
+ src => "$server/challenge?$qs",
+ }
+ ),
+ "\n",
+ $h->noscript(
+ [
+ $h->iframe(
+ {
+ src => "$server/noscript?$qs",
+ height => 300,
+ width => 500,
+ frameborder => 0
+ }
+ ),
+ $h->textarea(
+ {
+ name => 'recaptcha_challenge_field',
+ rows => 3,
+ cols => 40
+ }
+ ),
+ $h->input(
+ {
+ type => 'hidden',
+ name => 'recaptcha_response_field',
+ value => 'manual_challenge'
+ }
+ )
+ ]
+ ),
+ "\n"
+ );
+}
+
+sub _post_request {
+ my $self = shift;
+ my ( $url, $args ) = @_;
+
+ my $ua = LWP::UserAgent->new();
+ return $ua->post( $url, $args );
+}
+
+sub check_answer {
+ my $self = shift;
+ my ( $privkey, $remoteip, $challenge, $response ) = @_;
+
+ croak
+ "To use reCAPTCHA you must get an API key from https://www.google.com/recaptcha/admin/create"
+ unless $privkey;
+
+ croak "For security reasons, you must pass the remote ip to reCAPTCHA"
+ unless $remoteip;
+
+ return { is_valid => 0, error => 'incorrect-captcha-sol' }
+ unless $challenge && $response;
+
+ my $resp = $self->_post_request(
+ API_VERIFY_SERVER . '/recaptcha/api/verify',
+ {
+ privatekey => $privkey,
+ remoteip => $remoteip,
+ challenge => $challenge,
+ response => $response
+ }
+ );
+
+ if ( $resp->is_success ) {
+ my ( $answer, $message ) = split( /\n/, $resp->content, 2 );
+ if ( $answer =~ /true/ ) {
+ return { is_valid => 1 };
+ }
+ else {
+ chomp $message;
+ return { is_valid => 0, error => $message };
+ }
+ }
+ else {
+ return { is_valid => 0, error => SERVER_ERROR };
+ }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Captcha::reCAPTCHA - A Perl implementation of the reCAPTCHA API
+
+=head1 VERSION
+
+This document describes Captcha::reCAPTCHA version 0.93
+
+=head1 SYNOPSIS
+
+ use Captcha::reCAPTCHA;
+
+ my $c = Captcha::reCAPTCHA->new;
+
+ # Output form
+ print $c->get_html( 'your public key here' );
+
+ # Verify submission
+ my $result = $c->check_answer(
+ 'your private key here', $ENV{'REMOTE_ADDR'},
+ $challenge, $response
+ );
+
+ if ( $result->{is_valid} ) {
+ print "Yes!";
+ }
+ else {
+ # Error
+ $error = $result->{error};
+ }
+
+For complete examples see the /examples subdirectory
+
+=head1 DESCRIPTION
+
+reCAPTCHA is a hybrid mechanical turk and captcha that allows visitors
+who complete the captcha to assist in the digitization of books.
+
+From L<http://recaptcha.net/learnmore.html>:
+
+ reCAPTCHA improves the process of digitizing books by sending words that
+ cannot be read by computers to the Web in the form of CAPTCHAs for
+ humans to decipher. More specifically, each word that cannot be read
+ correctly by OCR is placed on an image and used as a CAPTCHA. This is
+ possible because most OCR programs alert you when a word cannot be read
+ correctly.
+
+This Perl implementation is modelled on the PHP interface that can be
+found here:
+
+L<http://recaptcha.net/plugins/php/>
+
+To use reCAPTCHA you need to register your site here:
+
+L<https://www.google.com/recaptcha/admin/create>
+
+=head1 INTERFACE
+
+=over
+
+=item C<< new >>
+
+Create a new C<< Captcha::reCAPTCHA >>.
+
+=item C<< get_html( $pubkey, $error, $use_ssl, $options ) >>
+
+Generates HTML to display the captcha.
+
+ print $captcha->get_html( $PUB, $err );
+
+=over
+
+=item C<< $pubkey >>
+
+Your reCAPTCHA public key, from the API Signup Page
+
+=item C<< $error >>
+
+Optional. If set this should be either a string containing a reCAPTCHA
+status code or a result hash as returned by C<< check_answer >>.
+
+=item C<< $use_ssl >>
+
+Optional. Should the SSL-based API be used? If you are displaying a page
+to the user over SSL, be sure to set this to true so an error dialog
+doesn't come up in the user's browser.
+
+=item C<< $options >>
+
+Optional. A reference to a hash of options for the captcha. See
+C<< get_options_setter >> for more details.
+
+=back
+
+Returns a string containing the HTML that should be used to display
+the captcha.
+
+=item C<< get_options_setter( $options ) >>
+
+You can optionally customize the look of the reCAPTCHA widget with some
+JavaScript settings. C<get_options_setter> returns a block of Javascript
+wrapped in <script> .. </script> tags that will set the options to be used
+by the widget.
+
+C<$options> is a reference to a hash that may contain the following keys:
+
+=over
+
+=item C<theme>
+
+Defines which theme to use for reCAPTCHA. Possible values are 'red',
+'white' or 'blackglass'. The default is 'red'.
+
+=item C<tabindex>
+
+Sets a tabindex for the reCAPTCHA text box. If other elements in the
+form use a tabindex, this should be set so that navigation is easier for
+the user. Default: 0.
+
+=back
+
+=item C<< check_answer >>
+
+After the user has filled out the HTML form, including their answer for
+the CAPTCHA, use C<< check_answer >> to check their answer when they
+submit the form. The user's answer will be in two form fields,
+recaptcha_challenge_field and recaptcha_response_field. The reCAPTCHA
+library will make an HTTP request to the reCAPTCHA server and verify the
+user's answer.
+
+=over
+
+=item C<< $privkey >>
+
+Your reCAPTCHA private key, from the API Signup Page.
+
+=item C<< $remoteip >>
+
+The user's IP address, in the format 192.168.0.1.
+
+=item C<< $challenge >>
+
+The value of the form field recaptcha_challenge_field
+
+=item C<< $response >>
+
+The value of the form field recaptcha_response_field.
+
+=back
+
+Returns a reference to a hash containing two fields: C<is_valid>
+and C<error>.
+
+ my $result = $c->check_answer(
+ 'your private key here', $ENV{'REMOTE_ADDR'},
+ $challenge, $response
+ );
+
+ if ( $result->{is_valid} ) {
+ print "Yes!";
+ }
+ else {
+ # Error
+ $error = $result->{error};
+ }
+
+See the /examples subdirectory for examples of how to call C<check_answer>.
+
+=back
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+Captcha::reCAPTCHA requires no configuration files or environment
+variables.
+
+To use reCAPTCHA sign up for a key pair here:
+
+L<https://www.google.com/recaptcha/admin/create>
+
+=head1 DEPENDENCIES
+
+LWP::UserAgent,
+HTML::Tiny
+
+=head1 INCOMPATIBILITIES
+
+None reported .
+
+=head1 BUGS AND LIMITATIONS
+
+No bugs have been reported.
+
+Please report any bugs or feature requests to
+C<bug-captcha-recaptcha at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org>.
+
+=head1 AUTHOR
+
+Andy Armstrong C<< <andy at hexten.net> >>
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) 2007, Andy Armstrong C<< <andy at hexten.net> >>. All rights reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
+
+=head1 DISCLAIMER OF WARRANTY
+
+BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
+ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
+YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+NECESSARY SERVICING, REPAIR, OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
+LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
+OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
+THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
Added: branches/upstream/libcaptcha-recaptcha-perl/current/t/00.load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/t/00.load.t?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/t/00.load.t (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/t/00.load.t Mon May 16 19:18:54 2011
@@ -1,0 +1,7 @@
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Captcha::reCAPTCHA' );
+}
+
+diag( "Testing Captcha::reCAPTCHA $Captcha::reCAPTCHA::VERSION" );
Added: branches/upstream/libcaptcha-recaptcha-perl/current/t/10.get_html.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/t/10.get_html.t?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/t/10.get_html.t (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/t/10.get_html.t Mon May 16 19:18:54 2011
@@ -1,0 +1,90 @@
+use strict;
+use warnings;
+use Test::More;
+use Captcha::reCAPTCHA;
+
+# Looks real. Isn't.
+use constant PUBKEY => '6LdAAAkAwAAAFJj6ACG3Wlix_GuQJMNGjMQnw5UY';
+
+my @schedule;
+
+BEGIN {
+ my $pubkey = PUBKEY;
+
+ @schedule = (
+ {
+ name => 'Simple',
+ args => [$pubkey],
+ expect =>
+ qq{<script src="http://www.google.com/recaptcha/api/challenge?k=$pubkey" }
+ . qq{type="text/javascript"></script>\n}
+ . qq{<noscript><iframe frameborder="0" height="300" }
+ . qq{src="http://www.google.com/recaptcha/api/noscript?k=$pubkey" }
+ . qq{width="500"></iframe><textarea cols="40" name="recaptcha_challenge_field" }
+ . qq{rows="3"></textarea><input name="recaptcha_response_field" type="hidden" }
+ . qq{value="manual_challenge" /></noscript>\n}
+ },
+ {
+ name => 'Error',
+ args => [ $pubkey, '<<some random error>>' ],
+ expect =>
+ qq{<script src="http://www.google.com/recaptcha/api/challenge?error=%3c%3csome+random+error%3e%3e&k=$pubkey" }
+ . qq{type="text/javascript"></script>\n}
+ . qq{<noscript><iframe frameborder="0" height="300" }
+ . qq{src="http://www.google.com/recaptcha/api/noscript?error=%3c%3csome+random+error%3e%3e&k=$pubkey" }
+ . qq{width="500"></iframe><textarea cols="40" name="recaptcha_challenge_field" }
+ . qq{rows="3"></textarea><input name="recaptcha_response_field" type="hidden" }
+ . qq{value="manual_challenge" /></noscript>\n}
+ },
+ {
+ name => 'Error in hash',
+ args =>
+ [ $pubkey, { is_valid => 0, error => '<<some random error>>' } ],
+ expect =>
+ qq{<script src="http://www.google.com/recaptcha/api/challenge?error=%3c%3csome+random+error%3e%3e&k=$pubkey" }
+ . qq{type="text/javascript"></script>\n}
+ . qq{<noscript><iframe frameborder="0" height="300" }
+ . qq{src="http://www.google.com/recaptcha/api/noscript?error=%3c%3csome+random+error%3e%3e&k=$pubkey" }
+ . qq{width="500"></iframe><textarea cols="40" name="recaptcha_challenge_field" }
+ . qq{rows="3"></textarea><input name="recaptcha_response_field" type="hidden" }
+ . qq{value="manual_challenge" /></noscript>\n}
+ },
+ {
+ name => 'Secure',
+ args => [ $pubkey, undef, 1 ],
+ expect =>
+ qq{<script src="https://www.google.com/recaptcha/api/challenge?k=$pubkey" }
+ . qq{type="text/javascript"></script>\n}
+ . qq{<noscript><iframe frameborder="0" height="300" }
+ . qq{src="https://www.google.com/recaptcha/api/noscript?k=$pubkey" }
+ . qq{width="500"></iframe><textarea cols="40" name="recaptcha_challenge_field" }
+ . qq{rows="3"></textarea><input name="recaptcha_response_field" type="hidden" }
+ . qq{value="manual_challenge" /></noscript>\n}
+ },
+ {
+ name => 'Options',
+ args =>
+ [ $pubkey, undef, 0, { theme => 'white', tabindex => 3 } ],
+ expect =>
+ qq(<script type="text/javascript">\n//<![CDATA[\nvar RecaptchaOptions = )
+ . qq({"tabindex":3,"theme":"white"};\n//]]>\n</script>\n)
+ . qq{<script src="http://www.google.com/recaptcha/api/challenge?k=$pubkey" }
+ . qq{type="text/javascript"></script>\n}
+ . qq{<noscript><iframe frameborder="0" height="300" }
+ . qq{src="http://www.google.com/recaptcha/api/noscript?k=$pubkey" }
+ . qq{width="500"></iframe><textarea cols="40" name="recaptcha_challenge_field" }
+ . qq{rows="3"></textarea><input name="recaptcha_response_field" type="hidden" }
+ . qq{value="manual_challenge" /></noscript>\n}
+ },
+ );
+ plan tests => 3 * @schedule;
+}
+
+for my $test ( @schedule ) {
+ my $name = $test->{name};
+ ok my $captcha = Captcha::reCAPTCHA->new(), "$name: Created OK";
+ isa_ok $captcha, 'Captcha::reCAPTCHA';
+ my $args = $test->{args};
+ my $html = $captcha->get_html( @$args );
+ is $html, $test->{expect}, "$name: Generate HTML OK";
+}
Added: branches/upstream/libcaptcha-recaptcha-perl/current/t/20.check_answer.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/t/20.check_answer.t?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/t/20.check_answer.t (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/t/20.check_answer.t Mon May 16 19:18:54 2011
@@ -1,0 +1,92 @@
+use strict;
+use warnings;
+use Test::More;
+use HTTP::Response;
+use Captcha::reCAPTCHA;
+use Data::Dumper;
+
+# Looks real. Isn't.
+use constant PRIVKEY => '6LdAAAkAwAAAix_GF6AMQnw5UCG3JjWluQJMNGjY';
+
+my @schedule;
+
+BEGIN {
+
+ # Looks real. Isn't.
+ @schedule = (
+ {
+ name => 'Simple correct',
+ args =>
+ [ PRIVKEY, '192.168.0.1', '..challenge..', '..response..' ],
+ response => "true\n",
+ check_args => {
+ privatekey => PRIVKEY,
+ remoteip => '192.168.0.1',
+ challenge => '..challenge..',
+ response => '..response..'
+ },
+ check_url => 'http://www.google.com/recaptcha/api/verify',
+ expect => { is_valid => 1 },
+ },
+ {
+ name => 'Simple incorrect',
+ args =>
+ [ PRIVKEY, '192.168.0.1', '..challenge..', '..response..' ],
+ response => "false\nincorrect-captcha-sol\n",
+ check_args => {
+ privatekey => PRIVKEY,
+ remoteip => '192.168.0.1',
+ challenge => '..challenge..',
+ response => '..response..'
+ },
+ check_url => 'http://www.google.com/recaptcha/api/verify',
+ expect => { is_valid => 0, error => 'incorrect-captcha-sol' },
+ },
+ );
+ plan tests => 6 * @schedule;
+}
+
+package T::Captcha::reCAPTCHA;
+
+our @ISA = qw(Captcha::reCAPTCHA);
+use Captcha::reCAPTCHA;
+
+sub set_response {
+ my $self = shift;
+ my $response = shift;
+ $self->{t_response} = $response;
+}
+
+sub _post_request {
+ my $self = shift;
+ my $url = shift;
+ my $args = shift;
+
+ # Just keep the args
+ $self->{t_url} = $url;
+ $self->{t_args} = $args;
+
+ return HTTP::Response->new( 200, 'OK',
+ [ 'Content-type:' => 'text/plain' ],
+ $self->{t_response} );
+}
+
+sub get_url { shift->{t_url} }
+sub get_args { shift->{t_args} }
+
+package main;
+
+for my $test ( @schedule ) {
+ my $name = $test->{name};
+ ok my $captcha = T::Captcha::reCAPTCHA->new(), "$name: Created OK";
+ isa_ok $captcha, 'Captcha::reCAPTCHA';
+ $captcha->set_response( $test->{response} );
+ ok my $resp = $captcha->check_answer( @{ $test->{args} } ),
+ "$name: got response";
+ is $captcha->get_url, $test->{check_url}, "$name: URL OK";
+ is_deeply $captcha->get_args, $test->{check_args}, "$name: args OK";
+ unless ( is_deeply $resp, $test->{expect}, "$name: result OK" ) {
+ diag( Data::Dumper->Dump( [ $test->{expect} ], ['$expected'] ) );
+ diag( Data::Dumper->Dump( [$resp], ['$got'] ) );
+ }
+}
Added: branches/upstream/libcaptcha-recaptcha-perl/current/t/40.errors.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/t/40.errors.t?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/t/40.errors.t (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/t/40.errors.t Mon May 16 19:18:54 2011
@@ -1,0 +1,97 @@
+use strict;
+use warnings;
+use Test::More;
+use Captcha::reCAPTCHA;
+
+use constant PUBKEY => '6LdAAAkAwAAAFJj6ACG3Wlix_GuQJMNGjMQnw5UY';
+use constant PRIVKEY => '6LdAAAkAwAAAix_GF6AMQnw5UCG3JjWluQJMNGjY';
+
+my @schedule;
+
+BEGIN {
+ @schedule = (
+ {
+ name => 'new: Bad args',
+ class => 'T::Captcha::reCAPTCHA',
+ try => sub {
+ my $c = Captcha::reCAPTCHA->new( PUBKEY );
+ },
+ expect => qr/reference to a hash/
+ },
+ {
+ name => 'get_html: No args',
+ class => 'T::Captcha::reCAPTCHA',
+ try => sub {
+ my $c = shift;
+ $c->get_html();
+ },
+ expect => qr/To use reCAPTCHA you must get an API key from/
+ },
+ {
+ name => 'get_html: No key',
+ class => 'T::Captcha::reCAPTCHA',
+ try => sub {
+ my $c = shift;
+ $c->get_html( '' );
+ },
+ expect => qr/To use reCAPTCHA you must get an API key from/
+ },
+ {
+ name => 'check_answer: No args',
+ class => 'T::Captcha::reCAPTCHA',
+ try => sub {
+ my $c = shift;
+ $c->check_answer();
+ },
+ expect => qr/To use reCAPTCHA you must get an API key from/
+ },
+ {
+ name => 'check_answer: no ip',
+ class => 'T::Captcha::reCAPTCHA',
+ try => sub {
+ my $c = shift;
+ $c->check_answer( PRIVKEY );
+ },
+ expect => qr/you must pass the remote ip/
+ },
+ );
+
+ plan tests => 3 * @schedule;
+}
+
+package T::Captcha::reCAPTCHA;
+
+our @ISA = qw(Captcha::reCAPTCHA);
+use Captcha::reCAPTCHA;
+
+sub _post_request {
+ my $self = shift;
+ my $url = shift;
+ my $args = shift;
+
+ # Just keep the args
+ $self->{t_url} = $url;
+ $self->{t_args} = $args;
+
+ return HTTP::Response->new( 200, 'OK',
+ [ 'Content-type:' => 'text/plain' ], "true\n" );
+}
+
+sub get_url { shift->{t_url} }
+sub get_args { shift->{t_args} }
+
+package main;
+
+for my $test ( @schedule ) {
+ my $name = $test->{name};
+ my $class = $test->{class};
+ ok my $captcha = $class->new, "$name: create OK";
+ isa_ok $captcha, $class;
+ eval { $test->{try}->( $captcha ); };
+ if ( my $expect = $test->{expect} ) {
+ like $@, $expect, "$name: error OK";
+ }
+ else {
+ ok !$@, "$name: no error OK";
+ }
+}
Added: branches/upstream/libcaptcha-recaptcha-perl/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/t/pod-coverage.t?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/t/pod-coverage.t (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/t/pod-coverage.t Mon May 16 19:18:54 2011
@@ -1,0 +1,9 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all =>
+ "Test::Pod::Coverage 1.04 required for testing POD coverage"
+ if $@;
+all_pod_coverage_ok(
+ { private => [ qr{^BUILD|DEMOLISH|AUTOMETHOD|START$}, qr{^_} ] } );
Added: branches/upstream/libcaptcha-recaptcha-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcaptcha-recaptcha-perl/current/t/pod.t?rev=74531&op=file
==============================================================================
--- branches/upstream/libcaptcha-recaptcha-perl/current/t/pod.t (added)
+++ branches/upstream/libcaptcha-recaptcha-perl/current/t/pod.t Mon May 16 19:18:54 2011
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
More information about the Pkg-perl-cvs-commits
mailing list