File Coverage

blib/lib/DBIx/CheckConnectivity/Driver.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	4	4	100.0
condition	4	6	66.6
subroutine	6	6	100.0
pod	1	1	100.0
total	41	43	95.3

package DBIx::CheckConnectivity::Driver;

use warnings;
use strict;
use Carp;

use DBI;
use Params::Validate qw/:all/;

sub check_connectivity {
    my $class = shift;
    validate(
        @_,
        {
            dsn       => { type => SCALAR,  regex    => qr/^dbi:/ },
            user      => 0,
            password  => 0,
            attribute => { type => HASHREF, optional => 1 },
        }
    );
    my %args     = @_;
    my $dsn      = $args{dsn};
    my $user     = $args{user} || '';
    my $password = $args{password} || '';

    my $attribute = $args{attribute} || { RaiseError => 0, PrintError => 0 };
    my ($database) = $dsn =~ m/dbi:(?:\w+):(?:(?:database|dbname)=)?(\w+)/;

    my $dbh = DBI->connect( $dsn, $user, $password, $attribute );

    return 1 if $dbh;
    # so we have an err
    return wantarray ? ( undef, DBI::errstr ) : undef;
}

1;

__END__