File Coverage

blib/lib/HealthCheck/Diagnostic/Redis.pm
Criterion Covered Total %
statement 58 60 96.6
branch 20 28 71.4
condition 5 12 41.6
subroutine 12 12 100.0
pod 3 5 60.0
total 98 117 83.7


line stmt bran cond sub pod time code
1             package HealthCheck::Diagnostic::Redis;
2              
3 1     1   99579 use strict;
  1         12  
  1         33  
4 1     1   5 use warnings;
  1         5  
  1         34  
5              
6 1     1   659 use parent 'HealthCheck::Diagnostic';
  1         296  
  1         6  
7              
8 1     1   4705 use Carp;
  1         2  
  1         52  
9 1     1   562 use Redis::Fast;
  1         18421  
  1         32  
10 1     1   555 use String::Random;
  1         3555  
  1         52  
11              
12             # ABSTRACT: Check for Redis connectivity and operations in HealthCheck
13 1     1   8 use version;
  1         2  
  1         4  
14             our $VERSION = 'v0.0.5'; # VERSION
15              
16             sub new {
17 2     2 1 2548 my ($class, @params) = @_;
18              
19             my %params = @params == 1 && ( ref $params[0] || '' ) eq 'HASH'
20 2 50 33     13 ? %{ $params[0] } : @params;
  0         0  
21              
22 2         13 return $class->SUPER::new(
23             id => 'redis',
24             label => 'redis',
25             %params,
26             );
27             }
28              
29             sub check {
30 8     8 1 6152 my ($self, %params) = @_;
31            
32             # Allow the diagnostic to be called as a class as well.
33 8 100       25 if ( ref $self ) {
34             $params{$_} = $self->{$_}
35 2         9 foreach grep { ! defined $params{$_} } keys %$self;
  6         23  
36             }
37            
38             # The host is the only required parameter.
39 8 100       237 croak "No host" unless $params{host};
40            
41 7         49 return $self->SUPER::check(%params);
42             }
43              
44             sub run {
45 7     7 1 156 my ($self, %params) = @_;
46              
47 7         13 my $host = $params{host};
48              
49 7         13 my $name = $params{name};
50 7 50       22 my $description = $name ? "$name ($host) Redis" : "$host Redis";
51              
52             # Add on the port if need be.
53 7 50       26 $host .= ':6379' unless $host =~ /:\d+$/;
54              
55             # Connect to the host...
56 7         12 my $redis;
57 7         32 local $@;
58 7         14 eval {
59 7         28 local $SIG{__DIE__};
60 7         26 $redis = Redis::Fast->new(
61             server => $host,
62              
63             # HealthCheck should not reconnect
64             reconnect => 0,
65              
66             # Make this quick...
67             cnx_timeout => 0.5,
68             read_timeout => 0.5,
69             write_timeout => 0.5,
70             );
71             };
72             return {
73 7 100       166 status => 'CRITICAL',
74             info => "Error for $description: $@",
75             } if $@;
76              
77 6 50       16 unless ($redis->ping) {
78             return {
79 0         0 status => 'CRITICAL',
80             info => "Error for $description: Redis ping failed",
81             };
82             }
83              
84             # Attempt to get a result from the readability or writeability
85             # test.
86             my $res = $params{read_only}
87 6 100       58 ? $self->test_read_only( $redis, $description, %params )
88             : $self->test_read_write( $redis, $description, %params );
89              
90 6 100       39 return $res if ref $res eq 'HASH';
91             return {
92 4         36 status => 'OK',
93             info => "Successful connection for $description",
94             };
95             }
96              
97             sub test_read_only {
98 2     2 0 8 my ($self, $redis, $description, %params) = @_;
99              
100 2   33     9 my ($key, $error) = ($params{key_name}) || $redis->randomkey;
101             return {
102 2 50       5 status => 'CRITICAL',
103             info => sprintf( 'Error for %s: Failed getting random entry - %s',
104             $description,
105             $error,
106             ),
107             } if $error;
108              
109             # When there is no key, that means we don't have anything in the
110             # database. No need to ping on that.
111 2 0 33     6 return unless $key || $params{key_name};
112              
113 2         6 my $val = $redis->get( $key );
114             return {
115 2 100       21 status => 'CRITICAL',
116             info => sprintf( 'Error for %s: Failed reading value of key %s',
117             $description,
118             $key,
119             ),
120             } unless defined $val;
121             }
122              
123             sub test_read_write {
124 4     4 0 13 my ($self, $redis, $description, %params) = @_;
125 4   66     20 my $key = $params{key_name} || sprintf(
126             '_health_check_%s',
127             String::Random->new->randregex('[A-Z0-9]{24}'),
128             );
129              
130             # Do not overwrite anything in the database.
131             return {
132 4 100       967 status => 'CRITICAL',
133             info => sprintf( 'Error for %s: Cannot overwrite key %s',
134             $description,
135             $key,
136             ),
137             } if defined $redis->get( $key );
138              
139             # Set, get, and delete the temporary value. Also set an expiration
140             # date of 5 seconds after setting just in-case.
141 3         46 $redis->set( $key => 'temp', EX => 5 );
142 3         19 my $val = $redis->get( $key );
143 3         20 $redis->del( $key );
144              
145             return {
146 3 50       23 status => 'CRITICAL',
147             info => sprintf( 'Error for %s: Failed writing to key %s',
148             $description,
149             $key,
150             ),
151             } unless defined $val;
152             }
153              
154             1;
155              
156             __END__