line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
$Kelp::Module::WebSocket::AnyEvent::VERSION = '1.05'; |
2
|
|
|
|
|
|
|
use Kelp::Base qw(Kelp::Module::Symbiosis::Base); |
3
|
2
|
|
|
2
|
|
78717
|
use Plack::App::WebSocket; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
10
|
|
4
|
2
|
|
|
2
|
|
2953
|
use Kelp::Module::WebSocket::AnyEvent::Connection; |
|
2
|
|
|
|
|
25051
|
|
|
2
|
|
|
|
|
50
|
|
5
|
2
|
|
|
2
|
|
806
|
use Carp qw(croak carp cluck); |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
10
|
|
6
|
2
|
|
|
2
|
|
60
|
use Try::Tiny; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
79
|
|
7
|
2
|
|
|
2
|
|
9
|
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
1812
|
|
8
|
|
|
|
|
|
|
attr "-serializer"; |
9
|
|
|
|
|
|
|
attr "-connections" => sub { {} }; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
attr "on_open" => sub { |
12
|
|
|
|
|
|
|
sub { } |
13
|
|
|
|
|
|
|
}; |
14
|
|
|
|
|
|
|
attr "on_close" => sub { |
15
|
|
|
|
|
|
|
sub { } |
16
|
|
|
|
|
|
|
}; |
17
|
|
|
|
|
|
|
attr "on_message" => sub { |
18
|
|
|
|
|
|
|
sub { } |
19
|
|
|
|
|
|
|
}; |
20
|
|
|
|
|
|
|
attr "on_malformed_message" => sub { |
21
|
|
|
|
|
|
|
sub { die pop } |
22
|
|
|
|
|
|
|
}; |
23
|
|
|
|
|
|
|
attr "on_error"; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# This function is here to work around Twiggy bug that is silencing errors |
26
|
|
|
|
|
|
|
# Warn them instead, so they can be logged and spotted |
27
|
|
|
|
|
|
|
{ |
28
|
|
|
|
|
|
|
my ($block) = @_; |
29
|
|
|
|
|
|
|
try { |
30
|
0
|
|
|
0
|
|
0
|
$block->(); |
31
|
|
|
|
|
|
|
} |
32
|
0
|
|
|
0
|
|
0
|
catch { |
33
|
|
|
|
|
|
|
cluck $_; |
34
|
|
|
|
|
|
|
die $_; |
35
|
0
|
|
|
0
|
|
0
|
}; |
36
|
0
|
|
|
|
|
0
|
} |
37
|
0
|
|
|
|
|
0
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
{ |
40
|
2
|
|
|
2
|
1
|
96
|
my ($self) = @_; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
my $conn_max_id = 0; |
43
|
|
|
|
|
|
|
my $websocket = Plack::App::WebSocket->new( |
44
|
0
|
|
|
0
|
1
|
0
|
|
45
|
|
|
|
|
|
|
# on_error - optional |
46
|
0
|
|
|
|
|
0
|
(defined $self->on_error ? (on_error => sub { $self->on_error->(@_) }) : ()), |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# on_establish - mandatory |
49
|
|
|
|
|
|
|
on_establish => sub { |
50
|
0
|
|
|
0
|
|
0
|
my ($orig_conn, $env) = @_; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
my $conn = Kelp::Module::WebSocket::AnyEvent::Connection->new( |
53
|
|
|
|
|
|
|
connection => $orig_conn, |
54
|
0
|
|
|
0
|
|
0
|
id => ++$conn_max_id, |
55
|
|
|
|
|
|
|
manager => $self |
56
|
0
|
|
|
|
|
0
|
); |
57
|
|
|
|
|
|
|
_trap { $self->on_open->($conn, $env) }; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
$conn->connection->on( |
60
|
|
|
|
|
|
|
message => sub { |
61
|
0
|
|
|
|
|
0
|
my ($orig_conn, $message) = @_; |
|
0
|
|
|
|
|
0
|
|
62
|
|
|
|
|
|
|
my $err; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
if (my $s = $self->get_serializer) { |
65
|
0
|
|
|
|
|
0
|
try { |
66
|
0
|
|
|
|
|
0
|
$message = $s->decode($message); |
67
|
|
|
|
|
|
|
} |
68
|
0
|
0
|
|
|
|
0
|
catch { |
69
|
|
|
|
|
|
|
$err = $_ || 'unknown error'; |
70
|
0
|
|
|
|
|
0
|
}; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
0
|
|
|
0
|
_trap { |
74
|
0
|
|
|
|
|
0
|
if ($err) { |
75
|
|
|
|
|
|
|
$self->on_malformed_message->($conn, $message, $err); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
else { |
78
|
0
|
0
|
|
|
|
0
|
$self->on_message->($conn, $message); |
79
|
0
|
|
|
|
|
0
|
} |
80
|
|
|
|
|
|
|
}; |
81
|
|
|
|
|
|
|
}, |
82
|
0
|
|
|
|
|
0
|
finish => sub { |
83
|
|
|
|
|
|
|
_trap { $self->on_close->($conn) }; |
84
|
0
|
|
|
|
|
0
|
$conn->close; |
85
|
|
|
|
|
|
|
undef $orig_conn; |
86
|
|
|
|
|
|
|
}, |
87
|
0
|
|
|
|
|
0
|
); |
|
0
|
|
|
|
|
0
|
|
88
|
0
|
|
|
|
|
0
|
} |
89
|
0
|
|
|
|
|
0
|
); |
90
|
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
0
|
return $websocket->to_app; |
92
|
|
|
|
|
|
|
} |
93
|
0
|
0
|
|
|
|
0
|
|
94
|
|
|
|
|
|
|
{ |
95
|
0
|
|
|
|
|
0
|
my ($self, $type, $sub) = @_; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
croak "websocket handler for $type is not a code reference" |
98
|
|
|
|
|
|
|
unless ref $sub eq 'CODE'; |
99
|
|
|
|
|
|
|
|
100
|
7
|
|
|
7
|
1
|
649
|
$type = "on_$type"; |
101
|
|
|
|
|
|
|
my $setter = $self->can($type); |
102
|
7
|
50
|
|
|
|
22
|
croak "unknown websocket event `$type`" |
103
|
|
|
|
|
|
|
unless defined $setter; |
104
|
|
|
|
|
|
|
|
105
|
7
|
|
|
|
|
13
|
return $setter->($self, $sub); |
106
|
7
|
|
|
|
|
17
|
} |
107
|
7
|
50
|
|
|
|
14
|
|
108
|
|
|
|
|
|
|
{ |
109
|
|
|
|
|
|
|
my ($self) = @_; |
110
|
7
|
|
|
|
|
13
|
return undef unless defined $self->serializer; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
my $real_serializer_method = $self->app->can($self->serializer); |
113
|
|
|
|
|
|
|
croak "Kelp doesn't have $self->serializer serializer" |
114
|
|
|
|
|
|
|
unless defined $real_serializer_method; |
115
|
0
|
|
|
0
|
0
|
0
|
|
116
|
0
|
0
|
|
|
|
0
|
return $real_serializer_method->($self->app); |
117
|
|
|
|
|
|
|
} |
118
|
0
|
|
|
|
|
0
|
|
119
|
0
|
0
|
|
|
|
0
|
{ |
120
|
|
|
|
|
|
|
my ($self, %args) = @_; |
121
|
|
|
|
|
|
|
$self->SUPER::build(%args); |
122
|
0
|
|
|
|
|
0
|
$self->{serializer} = $args{serializer} // $self->serializer; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
$self->register(websocket => $self); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
2
|
|
|
2
|
1
|
130
|
1; |
128
|
2
|
|
|
|
|
11
|
|
129
|
2
|
|
66
|
|
|
9
|
=pod |
130
|
|
|
|
|
|
|
|
131
|
2
|
|
|
|
|
14
|
=head1 NAME |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
Kelp::Module::WebSocket::AnyEvent - AnyEvent websocket server integration with Kelp |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head1 SYNOPSIS |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# in config |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
modules => [qw(Symbiosis WebSocket::AnyEvent)], |
140
|
|
|
|
|
|
|
modules_init => { |
141
|
|
|
|
|
|
|
"WebSocket::AnyEvent" => { |
142
|
|
|
|
|
|
|
mount => '/ws', |
143
|
|
|
|
|
|
|
serializer => "json", |
144
|
|
|
|
|
|
|
}, |
145
|
|
|
|
|
|
|
}, |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# in application's build method |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
my $ws = $self->websocket; |
151
|
|
|
|
|
|
|
$ws->add(message => sub { |
152
|
|
|
|
|
|
|
my ($conn, $msg) = @_; |
153
|
|
|
|
|
|
|
$conn->send({received => $msg}); |
154
|
|
|
|
|
|
|
}); |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# can also be mounted like this, if not specified in config |
157
|
|
|
|
|
|
|
$self->symbiosis->mount("/ws" => $ws); # by module object |
158
|
|
|
|
|
|
|
$self->symbiosis->mount("/ws" => 'websocket'); # by name |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# in psgi script |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
$app = MyApp->new; |
164
|
|
|
|
|
|
|
$app->run_all; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head1 DESCRIPTION |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
This is a module that integrates a websocket instance into Kelp using L<Kelp::Module::Symbiosis>. To run it, a non-blocking Plack server based on AnyEvent is required, like L<Twiggy>. All this module does is wrap L<Plack::App::WebSocket> instance in Kelp's module, introduce a method to get this instance in Kelp and integrate it into running alongside Kelp using Symbiosis. An instance of this class will be available in Kelp under the I<websocket> method. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head1 METHODS INTRODUCED TO KELP |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=head2 websocket |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Returns the instance of this class (Kelp::Module::WebSocket::AnyEvent). |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head1 METHODS |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 name |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sig: name($self) |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Reimplemented from L<Kelp::Module::Symbiosis::Base>. Returns a name of a module that can be used in C<< $symbiosis->loaded >> hash or when mounting by name. The return value is constant string I<'websocket'>. |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Requires Symbiosis version I<1.10> for name mounting to function. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head2 connections |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sig: connections($self) |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Returns a hashref containing all available L<Kelp::Module::WebSocket::AnyEvent::Connection> instances (open connections) keyed by their unique id. An id is autoincremented from 1 and guaranteed not to change and not to be replaced by a different connection unless the server restarts. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
A connection holds some additional data that can be used to hold custom data associated with that connection: |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# set / get data fields (it's an empty hash ref by default) |
196
|
|
|
|
|
|
|
$connection->data->{internal_id} = $internal_id; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# get the entire hash reference |
199
|
|
|
|
|
|
|
$hash_ref = $connection->data; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# replace the hash reference with something else |
202
|
|
|
|
|
|
|
$connection->data($something_else); |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=head2 middleware |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sig: middleware($self) |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
Returns an arrayref of all middlewares in format: C<[ middleware_class, [ middleware_config ] ]>. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=head2 psgi |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sig: psgi($self) |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Returns a ran instance of L<Plack::App::WebSocket>. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=head2 run |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sig: run($self) |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Same as psgi, but wraps the instance in all wanted middlewares. |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=head2 add |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sig: add($self, $event, $handler) |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
Registers a $handler (coderef) for websocket $event (string). Handler will be passed an instance of L<Kelp::Module::WebSocket::AnyEvent::Connection> and an incoming message. $event can be either one of: I<open close message error>. You can only specify one handler for each event type. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head1 EVENTS |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
All event handlers must be code references. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head2 open |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
open => sub ($new_connection, $env) { ... } |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
B<Optional>. Called when a new connection opens. A good place to set up its variables. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=head2 message |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
message => sub ($connection, $message) { ... } |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
B<Optional>. This is where you handle all the incoming websocket messages. If a serializer is specified, C<$message> will already be unserialized. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=head2 malformed_message |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
message => sub ($connection, $message, $error) { ... } |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
B<Optional>. This is where you handle the incoming websocket messages which could not be unserialized by a serializer. By default, an exception will be re-thrown, and effectively the connection will be closed. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
If Kelp JSON module is initialized with I<'allow_nonref'> flag then this event will never occur. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
C<$error> will not be likely be fit for end user message, as it will contain file names and line numbers. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head2 close |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
close => sub ($connection) { ... } |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
B<Optional>. Called when the connection is closing. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=head2 error |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
error => $psgi_app |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
B<Optional>. The code reference should be a psgi application. It will be called if an error occurs and the websocket connection have to be closed. |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head1 CONFIGURATION |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head2 middleware, middleware_init |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
See L<Kelp::Module::Symbiosis::Base/middleware, middleware_init>. |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=head2 mount |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
See L<Kelp::Module::Symbiosis::Base/mount>. |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=head2 serializer |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
Contains the name of the method that will be called to obtain an instance of serializer. Kelp instance must have that method registered. It must be able to C<< ->encode >> and C<< ->decode >>. Should also throw exception on error. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=head1 SEE ALSO |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=over 2 |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=item * L<Dancer2::Plugin::WebSocket>, same integration for Dancer2 framework this module was inspired by |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=item * L<Kelp>, the framework |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=item * L<Twiggy>, a server capable of running this websocket |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=back |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=head1 AUTHOR |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
Bartosz Jarzyna, E<lt>bbrtj.pro@gmail.comE<gt> |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
Copyright (C) 2020 - 2022 by Bartosz Jarzyna |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
301
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=cut |
304
|
|
|
|
|
|
|
|