File Coverage

blib/lib/Captcha/reCAPTCHA/V3.pm
Criterion Covered Total %
statement 60 78 76.9
branch 8 18 44.4
condition 13 38 34.2
subroutine 16 19 84.2
pod 7 9 77.7
total 104 162 64.2


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