File Coverage

blib/lib/Captcha/reCAPTCHA/V3.pm
Criterion Covered Total %
statement 63 88 71.5
branch 10 28 35.7
condition 13 37 35.1
subroutine 17 19 89.4
pod 7 9 77.7
total 110 181 60.7


line stmt bran cond sub pod time code
1             package Captcha::reCAPTCHA::V3;
2 4     4   517558 use 5.008001;
  4         11  
3 4     4   17 use strict;
  4         7  
  4         115  
4 4     4   29 use warnings;
  4         6  
  4         260  
5              
6             our $VERSION = "0.10";
7              
8 4     4   17 use Carp qw(carp croak);
  4         9  
  4         270  
9 4     4   2128 use JSON::PP qw(decode_json);
  4         44147  
  4         419  
10              
11             use overload(
12 3     3   8 '""' => sub { $_[0]->name() },
13 2     2   558 'cmp' => sub { $_[0]->name() cmp $_[1] },
14 4     4   26 );
  4         7  
  4         35  
15              
16             sub new {
17 4     4 1 365880 my $class = shift;
18 4   33     56 my $self = bless {}, ref $class || $class;
19 4         34 my %attr = @_;
20              
21             # Initialize the values for API
22 4   100     142 $self->{sitekey} = $attr{sitekey} || ''; # No need to set sitekey in server-side
23 4   33     20 $self->{secret} = $attr{secret} || croak "missing param 'secret'";
24 4   50     29 $self->{query_name} = $attr{query_name} || 'g-recaptcha-response';
25              
26 4         13 $self->{widget_api} = 'https://www.google.com/recaptcha/api.js';
27 4         15 $self->{verify_api} = 'https://www.google.com/recaptcha/api/siteverify';
28 4         18 return $self;
29             }
30              
31             sub name {
32 7     7 1 13 my $self = shift;
33 7 100       36 return $self->{query_name} unless my $value = shift;
34 1         4 $self->{query_name} = $value;
35             }
36              
37             sub sitekey {
38 1     1 1 2 my $self = shift;
39 1 50       3 return $self->{sitekey} unless my $value = shift;
40 1         3 $self->{sitekey} = $value;
41             }
42              
43             # verifiers =======================================================================
44             sub verify {
45 1     1 1 16 my $self = shift;
46 1         8 my $response = shift;
47 1 50       9 croak "Extra arguments have been set." if @_;
48              
49 1 50       15 if ( _has_curl() ) {
    0          
50             my $cmd = sprintf(
51             q{curl -sS -X POST %s -d secret=%s -d response=%s},
52             $self->{verify_api},
53 1         27 _shell_escape($self->{secret}),
54             _shell_escape($response),
55             );
56              
57 1 50       122085 my $json = `$cmd`or croak "Failed to execute curl command: $cmd";
58 1         45 return decode_json($json);
59             }elsif ( !_has_lwp_https() ) {
60 0         0 croak "LWP::UserAgent and LWP::Protocol::https are required to verify reCAPTCHA response.";
61             }
62              
63 0 0       0 eval {
64 0         0 require LWP::UserAgent;
65 0         0 require LWP::Protocol::https;
66             } or croak "LWP::UserAgent and LWP::Protocol::https are required to verify reCAPTCHA response.";
67              
68 0         0 my $ua = LWP::UserAgent->new;
69             my $res = $ua->post(
70             $self->{verify_api},{
71             secret => $self->{secret},
72 0         0 response => $response,
73             },
74             );
75              
76 0         0 my $json = $res->decoded_content;
77 0         0 return decode_json($json);
78             }
79              
80             sub deny_by_score {
81 0     0 1 0 my $self = shift;
82 0         0 my %attr = @_;
83 0   0     0 my $response = $attr{response} || croak "missing response token";
84 0   0     0 my $score = $attr{score} || 0.5;
85 0 0 0     0 croak "invalid score was set: $score" if $score < 0 or 1 < $score;
86              
87 0         0 my $content = $self->verify($response);
88 0 0 0     0 if ( $content->{success} and $content->{score} == 1 || $content->{score} < $score ) {
      0        
89 0         0 unshift @{ $content->{'error-codes'} }, 'too-low-score';
  0         0  
90 0         0 $content->{success} = 0;
91             }
92 0         0 return $content;
93             }
94              
95             sub verify_or_die {
96 0     0 1 0 my $self = shift;
97 0         0 my $content = $self->deny_by_score(@_);
98 0 0       0 return $content if $content->{success};
99 0         0 die 'fail to verify reCAPTCHA: ', $content->{'error-codes'}[0], "\n";
100             }
101              
102             # aroud javascript =======================================================================
103             sub scriptURL {
104 9     9 0 13 my $self = shift;
105 9         17 my %attr = @_;
106 9   66     260 my $sitekey = $attr{sitekey} || $self->{sitekey} || croak "missing 'sitekey'";
107 7         27 return $self->{widget_api} . "?render=$sitekey";
108             }
109              
110             sub scriptTag {
111 7     7 0 9 my $self = shift;
112 7         14 my %attr = @_;
113 7   66     186 my $sitekey = $attr{sitekey} || $self->{sitekey} || croak "missing 'sitekey'";
114 5         10 my $url = $self->scriptURL( sitekey => $sitekey );
115 5         19 return qq||;
116             }
117              
118             sub scripts {
119 5     5 1 10 my $self = shift;
120 5         13 my %attr = @_;
121 5   66     218 my $sitekey = $attr{sitekey} || $self->{sitekey} || croak "missing 'sitekey'";
122 3         6 my $simple = $self->scriptTag(@_);
123 3 50       7 my $id = $attr{'id'} or croak "missing the id for Form tag";
124 3   50     9 my $action = $attr{'action'} || 'homepage';
125 3 100       6 my $comment = $attr{'debug'} ? '' : '// ';
126 3         14 return <<"EOL";
127             $simple
128            
142             EOL
143             }
144              
145             # utils =======================================================================
146             sub _shell_escape {
147 2     2   15 my ($s) = @_;
148 2   50     11 $s //= '';
149 2         12 $s =~ s/'/'"'"'/g;
150 2         39 return "'$s'";
151             }
152              
153             sub _has_curl {
154 1 50   1   24285 return 1 if system("curl --version >nul 2>&1") == 0; # Windows
155 0 0         return 1 if system("curl --version >/dev/null 2>&1") == 0; # Unix
156 0           return 0;
157             }
158              
159             1;
160             __END__