File Coverage

blib/lib/DBIx/NamedDSN.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package DBIx::NamedDSN;

use 5.005;
use strict;
use vars qw($VERSION $DBI_KEY_NAME %CACHED_DSNS $NAMED_DSN_CONFIG $CONNECT_INFO_KEY);

use Carp;
use DBI;

$VERSION='0.11';
$DBI_KEY_NAME='ndsn_name';
$NAMED_DSN_CONFIG='/usr/local/etc/named_dsn.conf';
$CONNECT_INFO_KEY='ndsn_connection_info';

sub connect {
    my $self=shift;
    my ($name,$user,$pass,@rest)=@_;
    my ($dsn,$st_user,$st_passwd)=$self->get_cached_dsn($name);
    my $dbh;

    # here we pass it through if it looks like a dbi connect string,
    # so people can take advantage of the connect_string method with
    # normal boring handles.

    $dsn=$name if (!$dsn && $name=~/^dbi:/);
    croak "Unrecognized named DSN: '$name'.  (Do you need to add it in '".$NAMED_DSN_CONFIG."'?)" unless $dsn;

    $user||=$st_user;
    $pass||=$st_passwd;

    $dbh=DBI->connect($dsn,$user,$pass,@rest);

    if ($dbh) {
	my $hash=tied %$dbh;
	$hash->{$DBI_KEY_NAME}=$name;
	$hash->{$CONNECT_INFO_KEY}={connect_string=>$dsn,user=>$user,pass=>$pass,everything_else=>[@rest]};
    }
    return $dbh;
}

sub get_cached_dsn {
    my $self=shift;
    my $name=shift;

    unless (%CACHED_DSNS) {
	open FH, $NAMED_DSN_CONFIG or croak "Could not open config file: ".$NAMED_DSN_CONFIG;
	%CACHED_DSNS=map {split /\t/,$_,2} grep {/\w+\tdbi:\w+/} map {chomp; s/^\s+//; s/\#.*//;$_} ;
	close FH;
    }

    return unless defined $CACHED_DSNS{$name};

    return split(/\t/,$CACHED_DSNS{$name});
}

sub DBI::db::connection_string {
    my $self=shift;

    my $hash=tied %$self;
    return $hash->{$DBIx::NamedDSN::CONNECT_INFO_KEY}->{connect_string};
}

sub DBI::db::ndsn_identifier {
    my $self=shift;

    my $hash=tied %$self;
    return $hash->{$DBIx::NamedDSN::DBI_KEY_NAME};
}
1;

__END__