File Coverage

blib/lib/WebService/SSLLabs.pm
Criterion Covered Total %
statement 73 109 66.9
branch 10 24 41.6
condition 0 6 0.0
subroutine 16 22 72.7
pod 9 9 100.0
total 108 170 63.5


line stmt bran cond sub pod time code
1             package WebService::SSLLabs;
2              
3 3     3   202176 use strict;
  3         26  
  3         87  
4 3     3   16 use warnings;
  3         5  
  3         70  
5 3     3   1995 use JSON();
  3         37188  
  3         82  
6 3     3   1642 use URI::Escape();
  3         3869  
  3         72  
7 3     3   1929 use LWP::UserAgent();
  3         135470  
  3         77  
8 3     3   1395 use WebService::SSLLabs::Info();
  3         9  
  3         59  
9 3     3   1365 use WebService::SSLLabs::Host();
  3         8  
  3         70  
10 3     3   21 use WebService::SSLLabs::Endpoint();
  3         6  
  3         43  
11 3     3   1302 use WebService::SSLLabs::StatusCodes();
  3         8  
  3         3597  
12              
13             our $VERSION = '0.32';
14              
15 0     0   0 sub _MINIMUM_ETA_TIME { return 10; }
16              
17             sub new {
18 2     2 1 182 my ($class) = @_;
19 2         6 my $self = {};
20 2         5 bless $self, $class;
21 2         12 $self->{url} = 'https://api.ssllabs.com/api/v2/';
22 2         16 $self->{ua} = LWP::UserAgent->new();
23 2         5614 $self->{ua}->env_proxy();
24 2         28598 return $self;
25             }
26              
27             sub _parse_success {
28 0     0   0 my ( $self, $response ) = @_;
29             $self->{max_assessments} =
30 0         0 $response->headers()->header('X-Max-Assessments');
31             $self->{current_assessments} =
32 0         0 $response->headers()->header('X-Current-Assessments');
33 0         0 return;
34             }
35              
36             sub max_assessments {
37 0     0 1 0 my ($self) = @_;
38 0         0 return $self->{max_assessments};
39             }
40              
41             sub current_assessments {
42 0     0 1 0 my ($self) = @_;
43 0         0 return $self->{current_assessments};
44             }
45              
46             sub info {
47 1     1 1 10 my ($self) = @_;
48 1         4 my $url = $self->{url} . 'info';
49 1         6 my $response = $self->{ua}->get($url);
50 1 50       12298 if ( $response->is_success() ) {
51 0         0 $self->_parse_success($response);
52 0         0 return WebService::SSLLabs::Info->new(
53             JSON::decode_json( $response->decoded_content() ) );
54             }
55             else {
56 1         17 Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
57             }
58             }
59              
60             sub _translate_params {
61 17     17   44 my ( $self, %params ) = @_;
62 17         26 my %translated_params;
63 17         73 foreach my $key ( sort { $a cmp $b } sort keys %params ) {
  19         51  
64 34 50       79 if ( defined $params{$key} ) {
65 34         50 my $translated_key = $key;
66 34         108 $translated_key =~ s/_([[:lower:]])/uc $1/egsmx;
  11         46  
67 34         85 $translated_params{$translated_key} = $params{$key};
68             }
69             }
70 17         70 return %translated_params;
71             }
72              
73             sub analyze {
74 15     15 1 8801 my ( $self, %params ) = @_;
75 15         56 my %translated_params = $self->_translate_params(%params);
76             my $url = $self->{url} . 'analyze?' . (
77             join q[&],
78             map {
79 15         77 URI::Escape::uri_escape_utf8($_) . q[=]
80 28         491 . URI::Escape::uri_escape_utf8( $translated_params{$_} )
81             } sort _sort_ssllabs_params keys %translated_params
82             );
83 15         578 my $response = $self->{ua}->get($url);
84 15 50       2091 if ( $response->is_success() ) {
85 0         0 $self->_parse_success($response);
86 0         0 my $host = WebService::SSLLabs::Host->new(
87             JSON::decode_json( $response->decoded_content() ) );
88 0         0 $self->{_previous_host} = $host;
89 0         0 return $host;
90             }
91             else {
92 15         136 Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
93             }
94 0         0 return;
95             }
96              
97             sub previous_eta {
98 0     0 1 0 my ($self) = @_;
99 0         0 my $eta = _MINIMUM_ETA_TIME();
100 0 0       0 if ( $self->{_previous_host} ) {
101 0         0 my $host_eta = $self->{_previous_host}->eta();
102 0 0 0     0 if ( ( defined $host_eta )
      0        
103             && ( $host_eta =~ /^\d+$/smx )
104             && ( $host_eta >= $eta ) )
105             {
106 0         0 $eta = $host_eta;
107             }
108             }
109 0         0 return $eta;
110             }
111              
112             sub _sort_ssllabs_params {
113 18 100   18   54 if ( $a eq 'host' ) {
    100          
114 9         22 return -1;
115             }
116             elsif ( $b eq 'host' ) {
117 7         19 return 1;
118             }
119 2 50       6 if ( $a eq 's' ) {
    0          
120 2         4 return -1;
121             }
122             elsif ( $b eq 's' ) {
123 0         0 return 1;
124             }
125             else {
126 0         0 return $a cmp $b;
127             }
128             }
129              
130             sub get_endpoint_data {
131 2     2 1 921 my ( $self, %params ) = @_;
132 2         9 my %translated_params = $self->_translate_params(%params);
133             my $url = $self->{url} . 'getEndpointData?' . (
134             join q[&],
135             map {
136 2         12 URI::Escape::uri_escape_utf8($_) . q[=]
137 6         124 . URI::Escape::uri_escape_utf8( $translated_params{$_} )
138             } sort _sort_ssllabs_params keys %translated_params
139             );
140 2         60 my $response = $self->{ua}->get($url);
141 2 50       94 if ( $response->is_success() ) {
142 0         0 $self->_parse_success($response);
143 0         0 return WebService::SSLLabs::Endpoint->new(
144             JSON::decode_json( $response->decoded_content() ) );
145             }
146             else {
147 2         19 Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
148             }
149             }
150              
151             sub get_status_codes {
152 1     1 1 11338 my ($self) = @_;
153 1         6 my $url = $self->{url} . 'getStatusCodes';
154 1         5 my $response = $self->{ua}->get($url);
155 1 50       1422 if ( $response->is_success() ) {
156 0         0 $self->_parse_success($response);
157 0         0 return WebService::SSLLabs::StatusCodes->new(
158             JSON::decode_json( $response->decoded_content() ) );
159             }
160             else {
161 1         13 Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
162             }
163             }
164              
165             sub get_root_certs_raw {
166 0     0 1   my ($self) = @_;
167 0           my $url = $self->{url} . 'getRootCertsRaw';
168 0           my $response = $self->{ua}->get($url);
169 0 0         if ( $response->is_success() ) {
170 0           $self->_parse_success($response);
171 0           return $response->decoded_content();
172             }
173             else {
174 0           Carp::croak( "Failed to retrieve $url:" . $response->status_line() );
175             }
176             }
177              
178             1; # End of WebService::SSLLabs
179             __END__