File Coverage

blib/lib/Captcha/reCAPTCHA/V3.pm
Criterion Covered Total %
statement 60 76 78.9
branch 8 18 44.4
condition 13 38 34.2
subroutine 16 18 88.8
pod 7 9 77.7
total 104 159 65.4


line stmt bran cond sub pod time code
1             package Captcha::reCAPTCHA::V3;
2 4     4   214217 use 5.008001;
  4         47  
3 4     4   23 use strict;
  4         6  
  4         89  
4 4     4   18 use warnings;
  4         8  
  4         234  
5              
6             our $VERSION = "0.05";
7              
8 4     4   26 use Carp qw(carp croak);
  4         6  
  4         259  
9 4     4   2743 use JSON qw(decode_json);
  4         47328  
  4         27  
10 4     4   3589 use LWP::UserAgent;
  4         186107  
  4         437  
11             my $ua = LWP::UserAgent->new();
12              
13             use overload(
14 3     3   13 '""' => sub { $_[0]->name() },
15 2     2   459 'cmp' => sub { $_[0]->name() cmp $_[1] },
16 4     4   47 );
  4         12  
  4         54  
17              
18             sub new {
19 4     4 1 948 my $class = shift;
20 4   33     44 my $self = bless {}, ref $class || $class;
21 4         23 my %attr = @_;
22              
23             # Initialize the values for API
24 4   100     125 $self->{'sitekey'} = $attr{'sitekey'} || ''; # No need to set sitekey in server-side
25 4   33     23 $self->{'secret'} = $attr{'secret'} || croak "missing param 'secret'";
26 4   50     27 $self->{'query_name'} = $attr{'query_name'} || 'g-recaptcha-response';
27              
28 4         12 $self->{'widget_api'} = 'https://www.google.com/recaptcha/api.js';
29 4         11 $self->{'verify_api'} = 'https://www.google.com/recaptcha/api/siteverify';
30 4         16 return $self;
31             }
32              
33             sub name {
34 7     7 1 18 my $self = shift;
35 7 100       65 return $self->{'query_name'} unless my $value = shift;
36 1         3 $self->{'query_name'} = $value;
37             }
38              
39             sub sitekey {
40 1     1 1 3 my $self = shift;
41 1 50       6 return $self->{'sitekey'} unless my $value = shift;
42 1         3 $self->{'sitekey'} = $value;
43             }
44              
45             # verifiers =======================================================================
46             sub verify {
47 1     1 1 5 my $self = shift;
48 1         3 my $response = shift;
49 1 50       4 croak "Extra arguments have been set." if @_;
50              
51             my $params = {
52 1   33     13 secret => $self->{'secret'},
53             response => $response || croak "missing response token",
54             };
55              
56 1         12 my $res = $ua->post( $self->{'verify_api'}, $params );
57 1 50       281993 return decode_json $res->decoded_content() if $res->is_success();
58              
59 0         0 croak "something wrong to POST by " . $ua->agent(), "\n";
60             }
61              
62             sub deny_by_score {
63 0     0 1 0 my $self = shift;
64 0         0 my %attr = @_;
65 0   0     0 my $response = $attr{'response'} || croak "missing response token";
66 0   0     0 my $score = $attr{'score'} || 0.5;
67 0 0 0     0 croak "invalid score was set: $score" if $score < 0 or 1 < $score;
68              
69 0         0 my $content = $self->verify($response);
70 0 0 0     0 if ( $content->{'success'} and $content->{'score'} == 1 || $content->{'score'} < $score ) {
      0        
71 0         0 unshift @{ $content->{'error-codes'} }, 'too-low-score';
  0         0  
72 0         0 $content->{'success'} = 0;
73             }
74 0         0 return $content;
75             }
76              
77             sub verify_or_die {
78 0     0 1 0 my $self = shift;
79 0         0 my $content = $self->deny_by_score(@_);
80 0 0       0 return $content if $content->{'success'};
81 0         0 die 'fail to verify reCAPTCHA: ', $content->{'error-codes'}[0], "\n";
82             }
83              
84             # aroud javascript =======================================================================
85             sub scriptURL {
86 9     9 0 1145 my $self = shift;
87 9         23 my %attr = @_;
88 9   66     311 my $sitekey = $attr{'sitekey'} || $self->{'sitekey'} || croak "missing 'sitekey'";
89 7         45 return $self->{'widget_api'} . "?render=$sitekey";
90             }
91              
92             sub scriptTag {
93 7     7 0 819 my $self = shift;
94 7         20 my %attr = @_;
95 7   66     194 my $sitekey = $attr{'sitekey'} || $self->{'sitekey'} || croak "missing 'sitekey'";
96 5         12 my $url = $self->scriptURL( sitekey => $sitekey );
97 5         20 return qq||;
98             }
99              
100             sub scripts {
101 5     5 1 802 my $self = shift;
102 5         18 my %attr = @_;
103 5   66     178 my $sitekey = $attr{'sitekey'} || $self->{'sitekey'} || croak "missing 'sitekey'";
104 3         12 my $simple = $self->scriptTag(@_);
105 3 50       12 my $id = $attr{'id'} or croak "missing the id for Form tag";
106 3   50     12 my $action = $attr{'action'} || 'homepage';
107 3 100       8 my $comment = $attr{'debug'} ? '' : '// ';
108 3         22 return <<"EOL";
109             $simple
110            
124             EOL
125             }
126              
127             1;
128             __END__