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;
		}
	}

}