Pooling DBI handles

I've written the following DBIPool.pm to help manage my DBI handles.

Database aware functions need only call the pool with an alias, they dont need to keep the dsn/user/pass/%attrs around.

Also, DBIPool caches dbh's. Once your function goes out of scope, it stores the dbh for later usage.

I appreciate all comments and suggestions. Especially in the AUTOLOAD function. I'm using AUTOLOAD to dispatch the dbh calls to the actual $dbh. I haven't done much AUTOLOADing before and would be grateful for some advice.

Update: rescued from 60's as per grinder's suggestion

package DBIPool;

use strict;
use warnings;
use vars '$AUTOLOAD';

use DBI;

my %_Pools;
my %_Logins;
my $_DefaultAlias = "";


sub DefaultAlias 
{
    @_ ? ($_DefaultAlias = shift) : $_DefaultAlias;
}


sub SetLogin
{
    my %args = ( 
        alias => '',
        @_ 
    );
    
    $_Logins{$args{alias}} = \%args;
}


sub GetHandle
{
    my $alias = shift;

    if ( ! $alias )
    {
        $alias = DefaultAlias();
    }
    
    #
    #    check pool if there's an available connection
    #    
    my $pool = _GetPool($alias);    
    my $dbh;
    if ( @$pool > 0 )
    {
        $dbh = shift @$pool;
        my $pooledDbi = new DBIPool($alias,$dbh);
        return $pooledDbi;
    }
    
    #
    #    none exist, create an actual DBI connection
    #
    my $login = $_Logins{$alias};
    if ( ! $login )
    {
        Errors("dont know how to connect to [$alias]");
        return;
    }
    $dbh = DBI->connect(
        $$login{dsn},
        $$login{user},
        $$login{password},
        $login
    );
    
    if ( ! $dbh )
    {
        Errors("could not to connect to [$alias]");
        return;        
    }
    
    my $pooledDbi = new DBIPool($alias,$dbh);
    return $pooledDbi;
    
}

sub Errors
{
    foreach (@_)
    {
        my ($package, $filename, $line) = caller;
        my $error = $_ . " at $filename line $line";
        print STDERR $error . "\n";
        push @_Errors, $error;
    }
    wantarray ? return @_Errors : \@_Errors;
}

sub _GetPool
{
    my $alias = shift;    
    
    my $pool = $_Pools{$alias};
    if ( ! $pool )
    {
        #    create a pool
        my @newPool;
        $pool = \@newPool;
        $_Pools{$alias} = $pool;
    }
    
    return $pool;
}


sub new 
{
    my $self = bless( {}, shift );
    $self->{alias} = shift;
    $self->{dbh} = shift;
    return $self;
}


sub AUTOLOAD 
{
    my $obj = shift;
    
    if ( ! ref $obj) 
    {
        die "Unknown method [$AUTOLOAD]\n";
    }

    if ( $AUTOLOAD =~ /::(.*)$/ ) 
    {
        my $method = $1;
        if ( $method ne 'DESTROY') 
        {
            my $dbh = $obj->{dbh};
            if ($dbh->can($method))
            {
                $dbh->$method(@_);
            }
            else
            {
                die "Unknown method [$method]\n";
            }
        }
    }
}


sub DESTROY
{
    my $self = shift;
    
    #
    #    save dbh to a pool;
    #
    my $pool = _GetPool($self->{alias});
    my $dbh = $self->{dbh};
    push @$pool, $dbh;

}


sub END
{

    #
    #    explicitly disconnect and remove all dbh references 
    #
    foreach my $alias ( keys %_Pools )
    {
        my $pool = _GetPool($alias);
        while (my $dbh = shift @$pool )
        {
            $dbh->disconnect;
            $dbh = 0;
        }
    }

}
[download]

and here's and example of how to use it:


my $products_db_dsn = "";
my $products_db_user = "";
my $products_db_password = "";

my $customers_db_dsn = "";
my $customers_db_user = "";
my $customers_db_password = "";


DBIPool::SetLogin(
    alias     => 'products_db',
    dsn         => $products_db_dsn,
    user     => $products_db_user,
    password => $products_db_password,
);


DBIPool::SetLogin(
    alias     => 'customers_db',
    dsn         => $customers_db_dsn,
    user     => $customers_db_user,
    password => $customers_db_password,
);

ProcessAllProducts();

sub ProcessAllProducts
{
    my $dbh = DBIPool::GetHandle('products_db');
    my $sql = "select ProductID from Products";
    my $sth = $dbh->prepare($sql);
    if ( $sth->execute )
    {
        while (my $product = $sth->fetchrow_hashref )
        { 
            my $productID = $$product{ProductID};
            ProcessProductRegions($productID);
        }
    }
}

sub ProcessProductRegions
{
    my $productId = shift;
    my $dbh = DBIPool::GetHandle('products_db');
    my $sql = "select RegionID from ProductRegions where ProductID = ?
+";
    my $sth = $dbh->prepare($sql);
    if ( $sth->execute($productId) )
    {
        while (my $region = $sth->fetchrow_hashref )
        { 
            my $regionID = $$region{RegionID};
            ProcessRegionCustomers($regionID);
        }
    }
}

sub ProcessRegionCustomers
{
    my $regionID = shift;
    my $dbh = DBIPool::GetHandle('customers_db');
    my $sql = "select c.*  from RegionCustomers rc, Customers c where 
+rc.RegionID = ? and c.CustomerID = rc.CustomerID";
    my $sth = $dbh->prepare($sql);
    if ( $sth->execute($regionID) )
    {
        while (my $customer = $sth->fetchrow_hashref )
        { 
            #
            #    do some stuff for the customer here
            #
        }
    }
}
[download]

Comment on Pooling DBI handles Select or Download Code

Replies are listed 'Best First'.
Re: DBI Handles by adrianh (Chancellor) on Jan 20, 2003 at 18:27 UTC
You might want to take a look at ResourcePool::Factory::DBI which does something similar. You would construct a separate factory for each "alias" and then use that to get an appropriate handle.	[reply]
Re: Re: DBI Handles by LanceDeeply (Chaplain) on Jan 20, 2003 at 19:54 UTC
I didnt know that existed! The only thing I did see previously was Ima::DBI but it didnt seem to fit what I wanted. I'll definitely check out the whole ResourcePool lib. Thanks-	[reply]
Re: DBI Handles by valdez (Monsignor) on Jan 20, 2003 at 19:20 UTC
Interesting topic :) Why don't you `ping` the handle got from the pool before serving it? If you plan to run this code for long time, it is possible that stored handles won't work (morning bug or other failures). Apache::DBI uses the ping technique, and so (i presume) does ResourcePool; from its docs: The ResourcePool is a generic connection caching and pooling management facility. It might be used in an Apache/mod_perl environment to support connection caching like Apache::DBI for non-DBI resources (e.g. Net::LDAP). It's also useful in a stand alone perl application to handle connection pools. The key benefit of ResourcePool is the generic design which makes it easily extensible to new resource types. The ResourcePool has a simple check mechanism to detect and close broken connections (e.g. if the database server was restarted) and opens new connections if possible. but I haven't tried it yet. I don't know if it provides some sort of parachute, like the one from the previous module: In order to avoid inconsistencies in the database in case AutoCommit is off and the script finishes without an explicit rollback, the Apache::DBI module uses a PerlCleanupHandler to issue a rollback at the end of every request. Why are you wrapping every call to the original object? I did some experiments with connection pooling storing db handles at class level and I never thought about wrapping every call; it seems simpler to me to handle exceptions locally. Ciao, Valerio	[reply] [d/l]
Re: Re: DBI Handles by LanceDeeply (Chaplain) on Jan 21, 2003 at 03:36 UTC
Why are you wrapping every call to the original object? the thing that DBIPool::GetHandle() returns is a DBIPool object that processes dbi handle calls. I used the AUTOLOAD function to pass all the dbi handle calls from the DBIPool wrapper object to the dbh. Why don't you ping the handle got from the pool before serving it? If you plan to run this code for long time, it is possible that stored handles won't work (morning bug or other failures). i like the idea of testing the connection before returning it, but i've only been using this module for scripts that run once and complete, not daemons. Resource Pool does have a more robust interface, but I do prefer my little class for the run once scripts I'm using.	[reply]
Re: DBI Handles (error handling) by grinder (Bishop) on Jan 21, 2003 at 09:09 UTC
Handling errors with print statements? Eeeeeww, how terribly sixties :) And the error messages are not even going out on STDERR. There are better ways of signalling errors. Here's one: push them onto an internal queue, return undef, and let the client code pull them out with a Error method or some such. The client can choose to ignore them, print them to an IO handle of their choosing, email them... whatever. print@_{sort keys %_},$/if%_=split//,'= & *a?b:e\f/h^h!j+n,o@o;r$s-t%t#u'	[reply]
Re: Re: DBI Handles (error handling) by LanceDeeply (Chaplain) on Jan 21, 2003 at 16:14 UTC
True. I was in such a rush to share, I didnt 'robistify' that. Will change on next coffee break! Update: added the Error function to print to STDERR and hold errors in an internal array	[reply]


Welcome to the Monastery
	PerlMonks