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 1     1   58639 use version;
  1         1651  
  1         4  
5             our $VERSION = 'v1.2.3'; # VERSION
6              
7 1     1   85 use 5.010;
  1         5  
8 1     1   4 use strict;
  1         2  
  1         15  
9 1     1   4 use warnings;
  1         2  
  1         23  
10 1     1   382 use parent 'HealthCheck::Diagnostic';
  1         240  
  1         5  
11              
12 1     1   1903 use Carp;
  1         2  
  1         275  
13              
14             sub new {
15 4     4 1 3356 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     18 ? %{ $params[0] } : @params;
  0         0  
20              
21 4         20 return $class->SUPER::new(
22             label => 'dbh_ping',
23             %params
24             );
25             }
26              
27             sub check {
28 9     9 1 1067 my ( $self, %params ) = @_;
29              
30 9         17 my $dbh = $params{dbh};
31 9 100 66     37 $dbh ||= $self->{dbh} if ref $self;
32 9 100       24 $dbh = $dbh->(%params) if ref $dbh eq 'CODE';
33              
34 9 100 100     846 croak("Valid 'dbh' is required") unless $dbh and do {
35 6         8 local $@; local $SIG{__DIE__}; eval { $dbh->can('ping') } };
  6         19  
  6         10  
  6         194  
36              
37 4         18 my $res = $self->SUPER::check( %params, dbh => $dbh );
38 4         200 delete $res->{dbh}; # don't include the object in the result
39              
40 4         72 return $res;
41             }
42              
43             sub run {
44 4     4 1 66 my ( $self, %params ) = @_;
45 4         6 my $dbh = $params{dbh};
46              
47 4 100       15 my $status = $dbh->ping ? "OK" : "CRITICAL";
48 4 100       79 my $successful = $status eq "OK" ? "Successful" : "Unsuccessful";
49              
50 4         34 my $driver = $dbh->{Driver}->{Name};
51 4         20 my $info = "$successful $driver ping of $dbh->{Name}";
52 4 100       21 $info .= " as $dbh->{Username}" if $dbh->{Username};
53              
54 4         24 return { status => $status, info => $info };
55             }
56              
57             1;
58              
59             __END__