File Coverage

blib/lib/Captcha/reCAPTCHA/V3.pm
Criterion Covered Total %
statement 62 87 71.2
branch 11 30 36.6
condition 13 37 35.1
subroutine 16 18 88.8
pod 7 9 77.7
total 109 181 60.2


line stmt bran cond sub pod time code
1             package Captcha::reCAPTCHA::V3;
2             require 5.10.1;
3 5     5   532070 use strict;
  5         7  
  5         141  
4 5     5   15 use warnings;
  5         8  
  5         314  
5              
6             our $VERSION = "0.12";
7              
8 5     5   22 use Carp qw(carp croak);
  5         8  
  5         265  
9 5     5   2533 use JSON::PP qw(decode_json);
  5         56971  
  5         495  
10              
11             use overload(
12 3     3   24 '""' => sub { $_[0]->name() },
13 2     2   565 'cmp' => sub { $_[0]->name() cmp $_[1] },
14 5     5   27 );
  5         8  
  5         33  
15              
16             sub new {
17 5     5 1 494483 my $class = shift;
18 5   33     47 my $self = bless {}, ref $class || $class;
19 5         30 my %attr = @_;
20              
21             # Initialize the values for API
22 5   100     153 $self->{sitekey} = $attr{sitekey} || ''; # No need to set sitekey in server-side
23 5   33     29 $self->{secret} = $attr{secret} || croak "missing param 'secret'";
24 5   50     32 $self->{query_name} = $attr{query_name} || 'g-recaptcha-response';
25              
26 5         15 $self->{widget_api} = 'https://www.google.com/recaptcha/api.js';
27 5         14 $self->{verify_api} = 'https://www.google.com/recaptcha/api/siteverify';
28 5         19 return $self;
29             }
30              
31             sub name {
32 7     7 1 15 my $self = shift;
33 7 100       46 return $self->{query_name} unless my $value = shift;
34 1         2 $self->{query_name} = $value;
35             }
36              
37             sub sitekey {
38 1     1 1 2 my $self = shift;
39 1 50       7 return $self->{sitekey} unless my $value = shift;
40 1         5 $self->{sitekey} = $value;
41             }
42              
43             # verifiers =======================================================================
44             sub verify {
45 2     2 1 16 my $self = shift;
46 2         6 my $response = shift;
47 2 50       8 croak "Extra arguments have been set." if @_;
48              
49 2 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 2         59 _shell_escape($self->{secret}),
54             _shell_escape($response),
55             );
56              
57 2 50       268858 my $json = `$cmd`or croak "Failed to execute curl command: $cmd";
58 2         96 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 16 my $self = shift;
105 9         20 my %attr = @_;
106 9   66     267 my $sitekey = $attr{sitekey} || $self->{sitekey} || croak "missing 'sitekey'";
107 7         49 return $self->{widget_api} . "?render=$sitekey";
108             }
109              
110             sub scriptTag {
111 7     7 0 12 my $self = shift;
112 7         16 my %attr = @_;
113 7   66     195 my $sitekey = $attr{sitekey} || $self->{sitekey} || croak "missing 'sitekey'";
114 5         14 my $url = $self->scriptURL( sitekey => $sitekey );
115 5         19 return qq||;
116             }
117              
118             sub scripts {
119 5     5 1 9 my $self = shift;
120 5         19 my %attr = @_;
121 5   66     415 my $sitekey = $attr{sitekey} || $self->{sitekey} || croak "missing 'sitekey'";
122 3         8 my $simple = $self->scriptTag(@_);
123 3 50       8 my $id = $attr{'id'} or croak "missing the id for Form tag";
124 3   50     10 my $action = $attr{'action'} || 'homepage';
125 3 100       9 my $comment = $attr{'debug'} ? '' : '// ';
126 3         20 return <<"EOL";
127             $simple
128            
142             EOL
143             }
144              
145             # utils =======================================================================
146             sub _shell_escape {
147 4     4   31 my ($s) = @_;
148 4   50     28 $s //= '';
149 4         33 $s =~ s/'/'"'"'/g;
150 4         63 return "'$s'";
151             }
152              
153             sub _has_curl {
154 2 50   2   12 if ( $^O eq 'MSWin32' ) { # Windows
155 0 0       0 return 1 if system("curl --version >nul 2>&1") == 0;
156             } else { # Unix-like
157 2 50       42135 return 1 if system("curl --version >/dev/null 2>&1") == 0;
158             }
159 0           return 0;
160             }
161              
162             1;
163             __END__