File Coverage

blib/lib/Plack/App/WebSocket/Connection.pm
Criterion Covered Total %
statement 18 62 29.0
branch 0 12 0.0
condition n/a
subroutine 6 16 37.5
pod 3 4 75.0
total 27 94 28.7


line stmt bran cond sub pod time code
1             package Plack::App::WebSocket::Connection;
2 3     3   15 use strict;
  3         6  
  3         75  
3 3     3   15 use warnings;
  3         5  
  3         84  
4 3     3   15 use Carp;
  3         6  
  3         163  
5 3     3   14 use Scalar::Util qw(weaken);
  3         4  
  3         133  
6 3     3   14 use Devel::GlobalDestruction ();
  3         6  
  3         49  
7 3     3   16 use AnyEvent;
  3         8  
  3         1956  
8              
9             our $VERSION = "0.05";
10              
11             sub new {
12 0     0 0   my ($class, $conn, $responder) = @_;
13 0           my $self = bless {
14             connection => $conn,
15             responder => $responder,
16             handlers => {
17             message => [],
18             finish => [],
19             },
20             }, $class;
21 0           $self->_setup_internal_event_handlers();
22 0           return $self;
23             }
24              
25             sub _setup_internal_event_handlers {
26 0     0     my ($self) = @_;
27 0           weaken $self;
28             $self->{connection}->on(each_message => sub {
29 0 0   0     return if !defined($self);
30 0           my $strong_self = $self; ## make sure $self is alive during callback execution
31 0           $_->($self, $_[1]->body) foreach @{$self->{handlers}{message}};
  0            
32 0           });
33             $self->{connection}->on(finish => sub {
34 0 0   0     return if !defined($self);
35 0           my $strong_self = $self; ## make sure $self is alive during callback execution
36 0           $_->($self) foreach @{$self->{handlers}{finish}};
  0            
37 0           });
38             }
39              
40             sub _clear_event_handlers {
41 0     0     my ($self) = @_;
42 0           foreach my $handler_list (values %{$self->{handlers}}) {
  0            
43 0           @$handler_list = ();
44             }
45             }
46              
47             sub on {
48 0     0 1   my ($self, %handlers) = @_;
49 0           foreach my $event (keys %handlers) {
50 0           my $handler = $handlers{$event};
51 0 0         croak "handler for event $event must be a code-ref" if ref($handler) ne "CODE";
52 0 0         $event = "finish" if $event eq "close";
53 0           my $handler_list = $self->{handlers}{$event};
54 0 0         croak "Unknown event: $event" if not defined $handler_list;
55 0           push(@$handler_list, $handler);
56             }
57             }
58              
59             sub send {
60 0     0 1   my ($self, $message) = @_;
61 0           $self->{connection}->send($message);
62             }
63              
64             sub close {
65 0     0 1   my ($self) = @_;
66 0           $self->{connection}->close;
67             }
68              
69             our $WAIT_FOR_FLUSHING_SEC = 5;
70              
71             sub DESTROY {
72 0     0     my ($self) = @_;
73 0 0         return if Devel::GlobalDestruction::in_global_destruction;
74 0           $self->_clear_event_handlers();
75 0           my $connection = $self->{connection};
76 0           $connection->close(); ## explicit close because $responder may keep the socket.
77 0           my $responder = $self->{responder};
78 0           my $w; $w = AnyEvent->timer(after => $WAIT_FOR_FLUSHING_SEC, cb => sub {
79 0     0     $responder->([200, ["Content-Type", "text/plain"], ["WebSocket finished"]]);
80 0           undef $w;
81 0           undef $responder;
82              
83             ## Prolong $connection's life as long as $responder. This is
84             ## necessary to make sure $connection actively shuts down the
85             ## socket. If $connection is destroyed immediately and the
86             ## kernel's write buffer is full, $connection may fail to shut
87             ## down the socket (because $connection delays the active
88             ## shutdown after sending all the buffered data). If that
89             ## happens, the socket stays open, which is bad.
90 0           undef $connection;
91 0           });
92             }
93              
94             1;
95              
96             __END__