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


line stmt bran cond sub pod time code
1             # This is a proxy object for a socket. Its most important feature is
2             # that it passes the socket back to POE::Component::Client::Keepalive
3             # when it's destroyed.
4              
5             package POE::Component::Connection::Keepalive;
6             $POE::Component::Connection::Keepalive::VERSION = '0.272';
7 15     15   88 use warnings;
  15         29  
  15         715  
8 15     15   75 use strict;
  15         37  
  15         902  
9              
10 15     15   81 use Carp qw(croak);
  15         23  
  15         1231  
11 15     15   16826 use POE::Wheel::ReadWrite;
  15         194195  
  15         610  
12              
13 15     15   183 use constant DEBUG => 0;
  15         32  
  15         1328  
14              
15 15     15   81 use constant CK_SOCKET => 0; # The socket we're hiding.
  15         92  
  15         726  
16 15     15   84 use constant CK_MANAGER => 1; # The connection manager that owns the socket.
  15         34  
  15         803  
17 15     15   76 use constant CK_WHEEL => 2; # The wheel we're hiding.
  15         29  
  15         12193  
18              
19             # Assimilate a socket on construction, and the keep-alive connection
20             # so that free() may be called at destruction time.
21              
22             sub new {
23 34     34 1 419 my ($class, %args) = @_;
24              
25 34         207 my $self = bless [
26             $args{socket}, # CK_SOCKET
27             $args{manager}, # CK_MANAGER
28             undef, # CK_WHEEL
29             ], $class;
30              
31 34         137 return $self;
32             }
33              
34             # Free the socket on destruction.
35              
36             sub DESTROY {
37 34     34   1061677 my $self = shift;
38 34         144 $self->[CK_WHEEL] = undef;
39 34 50       1601 $self->[CK_MANAGER] and $self->[CK_MANAGER]->free($self->[CK_SOCKET]);
40             }
41              
42             # Start a Read/Write wheel on the hidden socket.
43              
44             sub start {
45 6     6 1 11131 my $self = shift;
46 6 100       378 croak "Must call start() with an even number of parameters" if @_ % 2;
47 5         25 my %args = @_;
48              
49             # Override the read/write handle with our own.
50 5         30 $args{Handle} = $self->[CK_SOCKET];
51              
52 5         37 $self->[CK_WHEEL] = POE::Wheel::ReadWrite->new(%args);
53             }
54              
55             # Wheel accessor, for modifying the wheel directly.
56              
57             sub wheel {
58 10     10 1 10816 my $self = shift;
59 10         84 return $self->[CK_WHEEL];
60             }
61              
62              
63             # For getting rid of the connection prematurely
64              
65             sub close {
66 1     1 1 338 my $self = shift;
67              
68 1         2 DEBUG and warn "closing $self ($self->[CK_WHEEL]) ($self->[CK_SOCKET])";
69 1 50       3 if (defined $self->wheel) {
70 1         3 $self->wheel->shutdown_input();
71 1         101 $self->wheel->shutdown_output();
72 1         143 $self->[CK_WHEEL] = undef;
73             }
74              
75             DEBUG and warn "about to close potentially tied socket/ tied = ", (
76 1         11 tied(*{$self->[CK_SOCKET]}) || 'no'
77             );
78 1         164 close $self->[CK_SOCKET];
79              
80 1         3 my $is_tied = defined tied(*{$self->[CK_SOCKET]});
  1         3  
81             # this is necessary so defined fileno() does the right thing
82             # on SSLified sockets
83 1 50       16 if ($is_tied) {
84 0         0 DEBUG and warn "about to untie";
85 0         0 untie(*{$self->[CK_SOCKET]});
  0         0  
86             }
87              
88 1         3 if (DEBUG) {
89             if (defined(fileno($self->[CK_SOCKET]))) {
90             warn "*** BUG: fileno still defined: " . fileno($self->[CK_SOCKET]);
91             }
92             }
93             }
94              
95             1;
96              
97             __END__