File Coverage

blib/lib/Google/reCAPTCHA.pm
Criterion Covered Total %
statement 43 43 100.0
branch 8 10 80.0
condition n/a
subroutine 12 12 100.0
pod 2 2 100.0
total 65 67 97.0


line stmt bran cond sub pod time code
1             package Google::reCAPTCHA;
2              
3 2     2   126127 use strict;
  2         5  
  2         53  
4 2     2   9 use warnings;
  2         3  
  2         50  
5              
6 2     2   9 use Carp;
  2         7  
  2         137  
7 2     2   2051 use LWP::UserAgent;
  2         179060  
  2         73  
8 2     2   2168 use JSON qw( decode_json );
  2         25977  
  2         9  
9 2     2   1996 use Params::Validate qw( validate SCALAR );
  2         20105  
  2         183  
10              
11             our $VERSION = '0.06';
12              
13 2     2   12 use constant URL => 'https://www.google.com/recaptcha/api/siteverify';
  2         4  
  2         1207  
14              
15             my $IPv4_re = "((25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))";
16             my $G = "[0-9a-fA-F]{1,4}";
17              
18             my @tail = ( ":",
19             "(:($G)?|$IPv4_re)",
20             ":($IPv4_re|$G(:$G)?|)",
21             "(:$IPv4_re|:$G(:$IPv4_re|(:$G){0,2})|:)",
22             "((:$G){0,2}(:$IPv4_re|(:$G){1,2})|:)",
23             "((:$G){0,3}(:$IPv4_re|(:$G){1,2})|:)",
24             "((:$G){0,4}(:$IPv4_re|(:$G){1,2})|:)"
25             );
26              
27             my $IPv6_re = $G;
28              
29             $IPv6_re = "$G:($IPv6_re|$_)" for @tail;
30             $IPv6_re = qq/:(:$G){0,5}((:$G){1,2}|:$IPv4_re)|$IPv6_re/;
31             $IPv6_re =~ s/\(/(?:/g;
32             $IPv6_re = qr/$IPv6_re/;
33              
34             sub new {
35 9     9 1 22269 my $class = shift;
36             my $self = validate( @_, {
37             secret => {
38             type => SCALAR,
39             callbacks => {
40             'is a secret key' =>
41 8     8   73 sub { $_[0] ne '' }
42             }
43             }
44 9         216 } );
45            
46 7         51 bless $self, $class;
47            
48 7         26 return $self;
49             }
50              
51             sub siteverify {
52 7     7 1 190 my $self = shift;
53             my $pd = validate( @_, {
54             response => {
55             type => SCALAR,
56             callbacks => {
57             'is a response code' =>
58 5     5   54 sub { $_[0] ne '' }
59             }
60             },
61             remoteip => {
62             type => SCALAR,
63             optional => 1,
64             callbacks => {
65             'is a remote ipv4 or ipv6 address' =>
66 6 100   6   1172 sub { $_[0] =~ /^$IPv4_re$/ || $_[0] =~ /^$IPv6_re$/ }
67             },
68             },
69 7         174 } );
70            
71 4         56 $pd->{secret} = $self->{secret};
72            
73 4         25 my $ua = LWP::UserAgent->new;
74 4         12209 $ua->ssl_opts( verify_hostname => 0 );
75              
76 4         106 my $response = $ua->post( URL , $pd );
77            
78 4 100       29 if ( $response->is_success) {
79 3         22 my $data = decode_json( $response->decoded_content );
80            
81 3 100       40 if ( exists ( $data->{'error-codes'} ) ) {
82 1         4 croak( 'API Error: ' . join( ', ', @{ $data->{'error-codes'} } ) );
  1         38  
83             }
84            
85 2 50       57 return $data->{success} ? 1 : 0;
86             }
87             else {
88 1 50       9 my $content = $response->decoded_content ? $response->decoded_content : '';
89 1         40 my $message = 'HTTP Request failed with status ' . $response->code . ' : ' . $content;
90              
91 1         16 croak( $message );
92             }
93             }
94            
95             1;
96             __END__