File Coverage

blib/lib/Plack/Middleware/SocketIO/Connection.pm
Criterion Covered Total %
statement 52 114 45.6
branch 11 20 55.0
condition 5 13 38.4
subroutine 10 30 33.3
pod 17 17 100.0
total 95 194 48.9


line stmt bran cond sub pod time code
1             package Plack::Middleware::SocketIO::Connection;
2              
3 2     2   819 use strict;
  2         5  
  2         70  
4 2     2   13 use warnings;
  2         5  
  2         57  
5              
6 2     2   10 use JSON ();
  2         12  
  2         98  
7 2     2   1796 use Try::Tiny;
  2         3116  
  2         2544  
8              
9             sub new {
10 1     1 1 915 my $class = shift;
11              
12 1         3 my $self = {@_};
13 1         3 bless $self, $class;
14              
15 1   50 0   12 $self->{on_connect} ||= sub { };
  0         0  
16 1   50 0   6 $self->{on_message} ||= sub { };
  0         0  
17 1   50 0   6 $self->{on_disconnect} ||= sub { };
  0         0  
18 1   50 0   8 $self->{on_error} ||= sub { };
  0         0  
19              
20 1         2 $self->{data} = '';
21 1   50 0   7 $self->{on_write} ||= sub { };
  0         0  
22              
23 1         1 $self->{last_activity} = 0;
24              
25 1         5 return $self;
26             }
27              
28             sub is_connected {
29 0     0 1 0 my $self = shift;
30              
31 0         0 return $self->{is_connected};
32             }
33              
34             sub connect {
35 0     0 1 0 my $self = shift;
36              
37 0         0 $self->{is_connected} = 1;
38              
39 0         0 $self->{on_connect}->($self);
40              
41 0         0 $self->{last_activity} = time;
42              
43 0         0 return $self;
44             }
45              
46             sub disconnect {
47 0     0 1 0 my $self = shift;
48              
49 0         0 $self->{is_connected} = 0;
50              
51 0         0 $self->{on_disconnect}->($self);
52              
53 0         0 return $self;
54             }
55              
56             sub id {
57 0     0 1 0 my $self = shift;
58              
59 0   0     0 $self->{id} ||= $self->_generate_id;
60              
61 0         0 return $self->{id};
62             }
63              
64             sub type {
65 0     0 1 0 my $self = shift;
66 0         0 my ($type) = @_;
67              
68 0 0       0 return $self->{type} unless defined $type;
69              
70 0         0 $self->{type} = $type;
71              
72 0         0 return $self;
73             }
74              
75 6     6 1 828 sub on_message { shift->on(message => @_) }
76 0     0 1 0 sub on_disconnect { shift->on(disconnect => @_) }
77 0     0 1 0 sub on_error { shift->on(error => @_) }
78 0     0 1 0 sub on_write { shift->on(write => @_) }
79              
80             sub on {
81 6     6 1 7 my $self = shift;
82 6         7 my ($event, $cb) = @_;
83              
84 6         9 my $name = "on_$event";
85              
86 6 100       19 return $self->{$name} unless $cb;
87              
88 2         4 $self->{$name} = $cb;
89              
90 2         7 return $self;
91             }
92              
93             sub read {
94 5     5 1 1481 my $self = shift;
95 5         8 my ($data) = @_;
96              
97 5 50       10 return $self unless defined $data;
98              
99 5         12 $self->{last_activity} = time;
100              
101 5         9 $self->{data} .= $data;
102              
103 5         11 while (my $message = $self->_parse_data) {
104 4         9 $self->on_message->($self, $message);
105             }
106              
107 5         9 return $self;
108             }
109              
110             sub send_heartbeat {
111 0     0 1 0 my $self = shift;
112              
113 0         0 $self->{heartbeat}++;
114              
115 0         0 return $self->send_message('~h~' . $self->{heartbeat});
116             }
117              
118             sub send_message {
119 0     0 1 0 my $self = shift;
120 0         0 my ($message) = @_;
121              
122 0         0 $self->{last_activity} = time;
123              
124 0         0 $message = $self->_build_message($message);
125              
126 0         0 $self->on_write->($self, $message);
127              
128 0         0 return $self;
129             }
130              
131             sub send_broadcast {
132 0     0 1 0 my $self = shift;
133 0         0 my ($message) = @_;
134              
135 0 0       0 my @conn = grep { $_->is_connected && $_->id ne $self->id }
  0         0  
136             Plack::Middleware::SocketIO::Resource->instance->connections;
137              
138 0         0 foreach my $conn (@conn) {
139 0         0 $conn->send_message($message);
140             }
141              
142 0         0 return $self;
143             }
144              
145             sub send_id_message {
146 0     0 1 0 my $self = shift;
147              
148 0         0 $self->{last_activity} = time;
149              
150 0         0 my $message = $self->build_id_message;
151              
152 0         0 $self->on_write->($self, $message);
153              
154 0         0 return $self;
155             }
156              
157             sub build_id_message {
158 0     0 1 0 my $self = shift;
159              
160 0         0 return $self->_build_message($self->id);
161             }
162              
163             sub _build_message {
164 0     0   0 my $self = shift;
165 0         0 my ($message) = @_;
166              
167 0 0       0 if (ref $message) {
168 0         0 $message = '~j~' . JSON::encode_json($message);
169             }
170              
171 0         0 return '~m~' . length($message) . '~m~' . $message;
172             }
173              
174             sub _generate_id {
175 0     0   0 my $self = shift;
176              
177 0         0 my $string = '';
178              
179 0         0 for (1 .. 16) {
180 0         0 $string .= int(rand(10));
181             }
182              
183 0         0 return $string;
184             }
185              
186             sub _parse_data {
187 10     10   21 my $self = shift;
188              
189 10 100       39 if ($self->{data} =~ s/^~m~(\d+)~m~//) {
190 5         9 my $length = $1;
191              
192 5         11 my $message = substr($self->{data}, 0, $length, '');
193 5 50       11 if (length($message) == $length) {
194 5 50       15 if ($message =~ m/^~h~(\d+)/) {
    100          
195 0         0 my $heartbeat = $1;
196              
197 0         0 return $self->_parse_data;
198             }
199             elsif ($message =~ m/^~j~(.*)/) {
200 2         2 my $json;
201              
202             try {
203 2     2   56 $json = JSON::decode_json($1);
204 2         10 };
205              
206 2 100       34 return $json if defined $json;
207              
208 1         6 return $self->_parse_data;
209             }
210             else {
211 3         8 return $message;
212             }
213             }
214             }
215              
216 5         7 $self->{data} = '';
217 5         12 return;
218             }
219              
220             1;
221             __END__