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]

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]