line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Dancer2::Plugin::WebSocket; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:YANICK'; |
3
|
|
|
|
|
|
|
# ABSTRACT: add a websocket interface to your Dancers app |
4
|
|
|
|
|
|
|
$Dancer2::Plugin::WebSocket::VERSION = '0.2.0'; |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
15
|
use v5.12.0; |
|
1
|
|
|
|
|
3
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
379
|
use Plack::App::WebSocket; |
|
1
|
|
|
|
|
68328
|
|
|
1
|
|
|
|
|
33
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
430
|
use Dancer2::Plugin; |
|
1
|
|
|
|
|
11238
|
|
|
1
|
|
|
|
|
8
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
has serializer => ( |
13
|
|
|
|
|
|
|
is => 'ro', |
14
|
|
|
|
|
|
|
from_config => 1, |
15
|
|
|
|
|
|
|
coerce => sub { |
16
|
|
|
|
|
|
|
my $serializer = shift or return undef; |
17
|
|
|
|
|
|
|
require JSON::MaybeXS; |
18
|
|
|
|
|
|
|
JSON::MaybeXS->new( ref $serializer ? %$serializer : () ); |
19
|
|
|
|
|
|
|
}, |
20
|
|
|
|
|
|
|
); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
has mount_path => ( |
23
|
|
|
|
|
|
|
is => 'ro', |
24
|
|
|
|
|
|
|
from_config => sub { '/ws' }, |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
has 'on_'.$_ => ( |
29
|
|
|
|
|
|
|
is => 'rw', |
30
|
|
|
|
|
|
|
plugin_keyword => 'websocket_on_'.$_, |
31
|
|
|
|
|
|
|
default => sub { sub { } }, |
32
|
|
|
|
|
|
|
) for qw/ |
33
|
|
|
|
|
|
|
open |
34
|
|
|
|
|
|
|
message |
35
|
|
|
|
|
|
|
close |
36
|
|
|
|
|
|
|
/; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
has 'on_error' => ( |
39
|
|
|
|
|
|
|
is => 'rw', |
40
|
|
|
|
|
|
|
plugin_keyword => 'websocket_on_error', |
41
|
|
|
|
|
|
|
default => sub { sub { |
42
|
|
|
|
|
|
|
my $env = shift; |
43
|
|
|
|
|
|
|
return [500, |
44
|
|
|
|
|
|
|
["Content-Type" => "text/plain"], |
45
|
|
|
|
|
|
|
["Error: " . $env->{"plack.app.websocket.error"}]]; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
}, |
48
|
|
|
|
|
|
|
); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
has connections => ( |
51
|
|
|
|
|
|
|
is => 'ro', |
52
|
|
|
|
|
|
|
default => sub{ {} }, |
53
|
|
|
|
|
|
|
); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub websocket_connections :PluginKeyword { |
57
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
58
|
0
|
|
|
|
|
0
|
return values %{ $self->connections }; |
|
0
|
|
|
|
|
0
|
|
59
|
1
|
|
|
1
|
|
3036
|
} |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
6
|
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub websocket_url :PluginKeyword { |
63
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
64
|
0
|
|
|
|
|
0
|
my $request = $self->app->request; |
65
|
0
|
0
|
|
|
|
0
|
my $proto = $request->secure ? 'wss://' : 'ws://'; |
66
|
0
|
|
|
|
|
0
|
my $address = $proto . $request->host . $self->mount_path; |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
0
|
return $address; |
69
|
1
|
|
|
1
|
|
474
|
} |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub websocket_mount :PluginKeyword { |
73
|
1
|
|
|
1
|
1
|
4
|
my $self = shift; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
return |
76
|
|
|
|
|
|
|
$self->mount_path => Plack::App::WebSocket->new( |
77
|
0
|
|
|
0
|
|
0
|
on_error => sub { $self->on_error->(@_) }, |
78
|
|
|
|
|
|
|
on_establish => sub { |
79
|
1
|
|
|
1
|
|
128684
|
my $conn = shift; ## Plack::App::WebSocket::Connection object |
80
|
1
|
|
|
|
|
1
|
my $env = shift; ## PSGI env |
81
|
|
|
|
|
|
|
|
82
|
1
|
|
|
|
|
36
|
require Moo::Role; |
83
|
|
|
|
|
|
|
|
84
|
1
|
|
|
|
|
10
|
Moo::Role->apply_roles_to_object( |
85
|
|
|
|
|
|
|
$conn, 'Dancer2::Plugin::WebSocket::Connection' |
86
|
|
|
|
|
|
|
); |
87
|
1
|
|
|
|
|
1651
|
$conn->manager($self); |
88
|
1
|
|
|
|
|
31
|
$conn->serializer($self->serializer); |
89
|
1
|
|
|
|
|
59
|
$self->connections->{$conn->id} = $conn; |
90
|
|
|
|
|
|
|
|
91
|
1
|
|
|
|
|
9
|
$self->on_open->( $conn, $env, @_ ); |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
$conn->on( |
94
|
|
|
|
|
|
|
message => sub { |
95
|
1
|
|
|
|
|
3999
|
my( $conn, $message ) = @_; |
96
|
1
|
50
|
|
|
|
10
|
if( my $s = $conn->serializer ) { |
97
|
1
|
|
|
|
|
9
|
$message = $s->decode($message); |
98
|
|
|
|
|
|
|
} |
99
|
1
|
|
|
1
|
|
567
|
use Try::Tiny; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
169
|
|
100
|
|
|
|
|
|
|
try { |
101
|
1
|
|
|
|
|
45
|
$self->on_message->( $conn, $message ); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
catch { |
104
|
0
|
|
|
|
|
|
warn $_; |
105
|
0
|
|
|
|
|
|
die $_; |
106
|
1
|
|
|
|
|
10
|
}; |
107
|
|
|
|
|
|
|
}, |
108
|
|
|
|
|
|
|
finish => sub { |
109
|
0
|
|
|
|
|
|
$self->on_close->($conn); |
110
|
0
|
|
|
|
|
|
delete $self->connections->{$conn->id}; |
111
|
0
|
|
|
|
|
|
$conn = undef; |
112
|
|
|
|
|
|
|
}, |
113
|
1
|
|
|
|
|
23
|
); |
114
|
|
|
|
|
|
|
} |
115
|
1
|
|
|
|
|
22
|
)->to_app; |
116
|
|
|
|
|
|
|
|
117
|
1
|
|
|
1
|
|
13
|
} |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
16
|
|
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
1; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
__END__ |