File Coverage

blib/lib/POE/Component/Connection/Keepalive.pm

Criterion	Covered	Total	%
statement	49	52	94.2
branch	5	8	62.5
condition			n/a
subroutine	13	13	100.0
pod	4	4	100.0
total	71	77	92.2

# This is a proxy object for a socket.  Its most important feature is
# that it passes the socket back to POE::Component::Client::Keepalive
# when it's destroyed.

package POE::Component::Connection::Keepalive;
$POE::Component::Connection::Keepalive::VERSION = '0.272';
use warnings;
use strict;

use Carp qw(croak);
use POE::Wheel::ReadWrite;

use constant DEBUG => 0;

use constant CK_SOCKET  => 0;  # The socket we're hiding.
use constant CK_MANAGER => 1;  # The connection manager that owns the socket.
use constant CK_WHEEL   => 2;  # The wheel we're hiding.

# Assimilate a socket on construction, and the keep-alive connection
# so that free() may be called at destruction time.

sub new {
  my ($class, %args) = @_;

  my $self = bless [
    $args{socket},      # CK_SOCKET
    $args{manager},     # CK_MANAGER
    undef,              # CK_WHEEL
  ], $class;

  return $self;
}

# Free the socket on destruction.

sub DESTROY {
  my $self = shift;
  $self->[CK_WHEEL] = undef;
  $self->[CK_MANAGER] and $self->[CK_MANAGER]->free($self->[CK_SOCKET]);
}

# Start a Read/Write wheel on the hidden socket.

sub start {
  my $self = shift;
  croak "Must call start() with an even number of parameters" if @_ % 2;
  my %args = @_;

  # Override the read/write handle with our own.
  $args{Handle} = $self->[CK_SOCKET];

  $self->[CK_WHEEL] = POE::Wheel::ReadWrite->new(%args);
}

# Wheel accessor, for modifying the wheel directly.

sub wheel {
  my $self = shift;
  return $self->[CK_WHEEL];
}


# For getting rid of the connection prematurely

sub close {
  my $self = shift;

  DEBUG and warn "closing $self ($self->[CK_WHEEL]) ($self->[CK_SOCKET])";
  if (defined $self->wheel) {
    $self->wheel->shutdown_input();
    $self->wheel->shutdown_output();
    $self->[CK_WHEEL] = undef;
  }

  DEBUG and warn "about to close potentially tied socket/ tied = ", (
    tied(*{$self->[CK_SOCKET]}) || 'no'
  );
  close $self->[CK_SOCKET];

  my $is_tied = defined tied(*{$self->[CK_SOCKET]});
  # this is necessary so defined fileno() does the right thing
  # on SSLified sockets
  if ($is_tied) {
    DEBUG and warn "about to untie";
    untie(*{$self->[CK_SOCKET]});
  }

  if (DEBUG) {
    if (defined(fileno($self->[CK_SOCKET]))) {
      warn "*** BUG: fileno still defined: " . fileno($self->[CK_SOCKET]);
    }
  }
}

1;

__END__