File Coverage

blib/lib/HealthCheck/Diagnostic/DBHPing.pm
Criterion Covered Total %
statement 40 41 97.5
branch 13 14 92.8
condition 6 9 66.6
subroutine 9 9 100.0
pod 3 3 100.0
total 71 76 93.4


line stmt bran cond sub pod time code
1             package HealthCheck::Diagnostic::DBHPing;
2              
3             # ABSTRACT: Ping a database handle to check its health
4 2     2   322509 use version;
  2         1807  
  2         13  
5             our $VERSION = 'v1.2.5'; # VERSION
6              
7 2     2   218 use 5.010;
  2         15  
8 2     2   12 use strict;
  2         10  
  2         38  
9 2     2   5 use warnings;
  2         9  
  2         112  
10 2     2   404 use parent 'HealthCheck::Diagnostic';
  2         283  
  2         12  
11              
12 2     2   9004 use Carp;
  2         5  
  2         800  
13              
14             sub new {
15 4     4 1 5691 my ($class, @params) = @_;
16              
17             # Allow either a hashref or even-sized list of params
18             my %params = @params == 1 && ( ref $params[0] || '' ) eq 'HASH'
19 4 50 33     21 ? %{ $params[0] } : @params;
  0         0  
20              
21 4         24 return $class->SUPER::new(
22             label => 'dbh_ping',
23             %params
24             );
25             }
26              
27             sub check {
28 9     9 1 230521 my ( $self, %params ) = @_;
29              
30 9         17 my $dbh = $params{dbh};
31 9 100 66     50 $dbh ||= $self->{dbh} if ref $self;
32 9 100       29 $dbh = $dbh->(%params) if ref $dbh eq 'CODE';
33              
34 9 100 100     1316 croak("Valid 'dbh' is required") unless $dbh and do {
35 6         11 local $@; local $SIG{__DIE__}; eval { $dbh->can('ping') } };
  6         22  
  6         12  
  6         267  
36              
37 4         23 my $res = $self->SUPER::check( %params, dbh => $dbh );
38 4         392 delete $res->{dbh}; # don't include the object in the result
39              
40 4         148 return $res;
41             }
42              
43             sub run {
44 4     4 1 101 my ( $self, %params ) = @_;
45 4         9 my $dbh = $params{dbh};
46              
47 4 100       21 my $status = $dbh->ping ? "OK" : "CRITICAL";
48 4 100       77 my $successful = $status eq "OK" ? "Successful" : "Unsuccessful";
49              
50 4         43 my $driver = $dbh->{Driver}->{Name};
51 4         23 my $info = "$successful $driver ping of $dbh->{Name}";
52 4 100       26 $info .= " as $dbh->{Username}" if $dbh->{Username};
53              
54 4         30 return { status => $status, info => $info };
55             }
56              
57             1;
58              
59             __END__