File Coverage

blib/lib/DBIx/DSN/Resolver.pm

Criterion	Covered	Total	%
statement	43	44	97.7
branch	18	20	90.0
condition			n/a
subroutine	8	8	100.0
pod	0	2	0.0
total	69	74	93.2

package DBIx::DSN::Resolver;

use strict;
use warnings;
use DBI;
use Socket;
use Carp;

our $VERSION = '0.09';

sub new {
    my $class = shift;
    my %args = @_ == 1 ? %{$_[0]} : @_;
    bless {
        resolver => sub {
            my $ipaddr = Socket::inet_aton($_[0]);
            return unless $ipaddr;
            Socket::inet_ntoa($ipaddr);
        },
        %args,
    }, $class;
}

sub resolv {
    my $self = shift;
    my $dsn = shift;
    return unless $dsn;

    my ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn)
        = DBI->parse_dsn($dsn)
            or croak "Can't parse DBI DSN '$dsn'";

    my %driver_hash;
    my @driver_hash_keys; #to keep order
    for my $d ( split /;/, $driver_dsn ) {
        my ( $k, $v) = split /=/, $d, 2;
        $driver_hash{$k} = $v;
        push @driver_hash_keys, $k;
    }
    my $host_key = exists $driver_hash{hostname} ? 'hostname' : 'host';
    my $host = $driver_hash{$host_key};
    return $dsn unless $host;

    my $port = '';
    if ( $host =~ m!:(\d+)$! ) {
        $port = ':'.$1;
        $host =~ s!:(\d+)$!!;
    }

    my $ipaddr = $self->{resolver}->($host)
        or croak "Can't resolv host name: $host, $!";
    $driver_hash{$host_key} = $ipaddr . $port;

    $driver_dsn = join ';', map { defined $driver_hash{$_} ? $_.'='.$driver_hash{$_} : $_ } @driver_hash_keys;
    $attr_string = defined $attr_string
        ? '('.$attr_string.')'
        : '';
    sprintf "%s:%s%s:%s", $scheme, $driver, $attr_string, $driver_dsn;
}


1;
__END__