view release on metacpan or  search on metacpan

lib/DBIx/QueryByName/DbhPool.pm  view on Meta::CPAN

package DBIx::QueryByName::DbhPool;

use utf8;
use strict;
use warnings;

use DBI;
use DBIx::QueryByName::Logger qw(get_logger debug);
use Scalar::Util qw(weaken);

sub new {
    return bless( { connections => {}, config => {} }, $_[0] );
}

sub parent {
    my ($self, $parent) = @_;
    $self->{sthpool} = $parent->_sth_pool;
    weaken $self->{sthpool};
}

sub add_credentials {
    my ($self, $session, @params) = @_;
	my $log = get_logger();
    $log->logcroak("undefined session name") if (!defined $session);
    $log->logcroak("no session parameters provided") if (scalar @params == 0);
    $log->logcroak("credentials for session [$session] are already declared") if ($self->knows_session($session));
    $self->{config}->{$session} = \@params;
    return $self;
}

sub knows_session {
    my ($self, $session) = @_;
	my $log = get_logger();
    $log->logcroak("undefined session name") if (!defined $session);
    return (exists $self->{config}->{$session}) ? 1 : 0;
}

sub _inactivate_parent_connections {
    my $self = shift;

    foreach my $pid ( keys %{$self->{connections}} ) {
        foreach my $session ( keys %{$self->{connections}->{$pid}} ) {
            if ( $$ != $pid ) {
                if ( defined $self->{connections}->{$pid}->{$session}->{InactiveDestroy} &&
                     $self->{connections}->{$pid}->{$session}->{InactiveDestroy} != 1 ) {
                    # the connection belongs to an other process than self.
                    # Prevent forked child (this pid) from disconnecting the database connection
                    debug "Setting connection for pid $$ and session $session as InactiveDestroy";
                    $self->{connections}->{$pid}->{$session}->{InactiveDestroy} = 1;
                    delete $self->{connections}->{$pid}->{$session};
                }
            }
        }
    }    
    
    1;
}

# open database connection for the given session and return a database
# handler
sub connect {
    my ($self, $session) = @_;
	my $log = get_logger();
    $log->logcroak("undefined session name") if (!defined $session);

    return $self->{connections}->{$$}->{$session} if (defined $self->{connections}->{$$}->{$session});

    # Before opening connection, we need to set InactiveDestroy on
    # other processes connections. Even then, there is a risk that a
    # process that just forks but open no own connections will close
    # all the connections of related processes upon exit.
    $self->_inactivate_parent_connections();
    
    # try to open database connection
    # TODO: implement a giveup limit?
    my $error_reported = 0;
    while (1) {
        $log->logcroak("don't know how to open connection [$session]")