File Coverage

blib/lib/Captcha/reCAPTCHA/V3.pm
Criterion Covered Total %
statement 65 81 80.2
branch 8 18 44.4
condition 13 38 34.2
subroutine 17 19 89.4
pod 7 9 77.7
total 110 165 66.6


line stmt bran cond sub pod time code
1             package Captcha::reCAPTCHA::V3;
2 4     4   678134 use 5.008001;
  4         15  
3 4     4   22 use strict;
  4         6  
  4         135  
4 4     4   20 use warnings;
  4         16  
  4         368  
5              
6             our $VERSION = "0.06";
7              
8 4     4   23 use Carp qw(carp croak);
  4         16  
  4         372  
9 4     4   2885 use JSON qw(decode_json);
  4         57792  
  4         27  
10 4     4   4011 use LWP::UserAgent;
  4         264562  
  4         515  
11              
12             use overload(
13 3     3   13 '""' => sub { $_[0]->name() },
14 2     2   1060 'cmp' => sub { $_[0]->name() cmp $_[1] },
15 4     4   49 );
  4         9  
  4         62  
16              
17             sub new {
18 4     4 1 659786 my $class = shift;
19 4   33     41 my $self = bless {}, ref $class || $class;
20 4         26 my %attr = @_;
21              
22             # Initialize the values for API
23 4   100     169 $self->{'sitekey'} = $attr{'sitekey'} || ''; # No need to set sitekey in server-side
24 4   33     23 $self->{'secret'} = $attr{'secret'} || croak "missing param 'secret'";
25 4   50     30 $self->{'query_name'} = $attr{'query_name'} || 'g-recaptcha-response';
26              
27 4         14 $self->{'widget_api'} = 'https://www.google.com/recaptcha/api.js';
28 4         16 $self->{'verify_api'} = 'https://www.google.com/recaptcha/api/siteverify';
29 4         17 return $self;
30             }
31              
32             sub name {
33 7     7 1 22 my $self = shift;
34 7 100       60 return $self->{'query_name'} unless my $value = shift;
35 1         4 $self->{'query_name'} = $value;
36             }
37              
38             sub sitekey {
39 1     1 1 3 my $self = shift;
40 1 50       7 return $self->{'sitekey'} unless my $value = shift;
41 1         4 $self->{'sitekey'} = $value;
42             }
43              
44             # verifiers =======================================================================
45             sub verify {
46 1     1 1 6 my $self = shift;
47 1         2 my $response = shift;
48 1 50       4 croak "Extra arguments have been set." if @_;
49              
50             my $params = {
51 1   33     6 secret => $self->{'secret'},
52             response => $response || croak "missing response token",
53             };
54              
55 1         16 my $ua = LWP::UserAgent->new();
56              
57             # Enable LWP debugging
58 4     4   5001 use LWP::Debug qw(+);
  4         3075  
  4         31  
59              
60 1         3100 my $res = $ua->post( $self->{'verify_api'}, $params );
61 1 50       316182 if ( $res->is_success ) {
62 1         386 return decode_json( $res->decoded_content );
63             } else {
64 0         0 croak $res->status_line;
65             }
66             }
67              
68             sub deny_by_score {
69 0     0 1 0 my $self = shift;
70 0         0 my %attr = @_;
71 0   0     0 my $response = $attr{'response'} || croak "missing response token";
72 0   0     0 my $score = $attr{'score'} || 0.5;
73 0 0 0     0 croak "invalid score was set: $score" if $score < 0 or 1 < $score;
74              
75 0         0 my $content = $self->verify($response);
76 0 0 0     0 if ( $content->{'success'} and $content->{'score'} == 1 || $content->{'score'} < $score ) {
      0        
77 0         0 unshift @{ $content->{'error-codes'} }, 'too-low-score';
  0         0  
78 0         0 $content->{'success'} = 0;
79             }
80 0         0 return $content;
81             }
82              
83             sub verify_or_die {
84 0     0 1 0 my $self = shift;
85 0         0 my $content = $self->deny_by_score(@_);
86 0 0       0 return $content if $content->{'success'};
87 0         0 die 'fail to verify reCAPTCHA: ', $content->{'error-codes'}[0], "\n";
88             }
89              
90             # aroud javascript =======================================================================
91             sub scriptURL {
92 9     9 0 24 my $self = shift;
93 9         27 my %attr = @_;
94 9   66     483 my $sitekey = $attr{'sitekey'} || $self->{'sitekey'} || croak "missing 'sitekey'";
95 7         44 return $self->{'widget_api'} . "?render=$sitekey";
96             }
97              
98             sub scriptTag {
99 7     7 0 34 my $self = shift;
100 7         30 my %attr = @_;
101 7   66     347 my $sitekey = $attr{'sitekey'} || $self->{'sitekey'} || croak "missing 'sitekey'";
102 5         13 my $url = $self->scriptURL( sitekey => $sitekey );
103 5         24 return qq||;
104             }
105              
106             sub scripts {
107 5     5 1 14 my $self = shift;
108 5         25 my %attr = @_;
109 5   66     346 my $sitekey = $attr{'sitekey'} || $self->{'sitekey'} || croak "missing 'sitekey'";
110 3         12 my $simple = $self->scriptTag(@_);
111 3 50       11 my $id = $attr{'id'} or croak "missing the id for Form tag";
112 3   50     13 my $action = $attr{'action'} || 'homepage';
113 3 100       11 my $comment = $attr{'debug'} ? '' : '// ';
114 3         21 return <<"EOL";
115             $simple
116            
130             EOL
131             }
132              
133             1;
134             __END__