File Coverage

blib/lib/Kelp/Module/WebSocket/AnyEvent.pm
Criterion Covered Total %
statement 24 53 45.2
branch 1 10 10.0
condition 1 3 33.3
subroutine 7 14 50.0
pod 3 4 75.0
total 36 84 42.8


line stmt bran cond sub pod time code
1             package Kelp::Module::WebSocket::AnyEvent;
2              
3             our $VERSION = '1.02';
4              
5 1     1   5996 use Kelp::Base qw(Kelp::Module::Symbiosis::Base);
  1         3  
  1         7  
6 1     1   2006 use Plack::App::WebSocket;
  1         15772  
  1         35  
7 1     1   561 use Kelp::Module::WebSocket::AnyEvent::Connection;
  1         3  
  1         6  
8 1     1   39 use Carp qw(croak carp cluck);
  1         2  
  1         54  
9 1     1   6 use Try::Tiny;
  1         2  
  1         1251  
10              
11             attr "-serializer";
12             attr "-connections" => sub { {} };
13              
14             attr "on_open" => sub {
15             sub { }
16             };
17             attr "on_close" => sub {
18             sub { }
19             };
20             attr "on_message" => sub {
21             sub { }
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             sub _trap(&)
28             {
29 0     0   0 my ($block) = @_;
30             try {
31 0     0   0 $block->();
32             }
33             catch {
34 0     0   0 cluck $_;
35 0         0 die $_;
36 0         0 };
37             }
38              
39             sub psgi
40             {
41 0     0 1 0 my ($self) = @_;
42              
43 0         0 my $conn_max_id = 0;
44             my $websocket = Plack::App::WebSocket->new(
45              
46             # on_error - optional
47 0     0   0 (defined $self->on_error ? (on_error => sub { $self->on_error->(@_) }) : ()),
48              
49             # on_establish - mandatory
50             on_establish => sub {
51 0     0   0 my ($orig_conn, $env) = @_;
52              
53 0         0 my $conn = Kelp::Module::WebSocket::AnyEvent::Connection->new(
54             connection => $orig_conn,
55             id => ++$conn_max_id,
56             manager => $self
57             );
58 0         0 _trap { $self->on_open->($conn, $env) };
  0         0  
59              
60             $conn->connection->on(
61             message => sub {
62 0         0 my ($orig_conn, $message) = @_;
63 0 0       0 if (my $s = $self->get_serializer) {
64 0         0 $message = $s->decode($message);
65             }
66 0         0 _trap { $self->on_message->($conn, $message) };
  0         0  
67             },
68             finish => sub {
69 0         0 _trap { $self->on_close->($conn) };
  0         0  
70 0         0 $conn->close;
71 0         0 undef $orig_conn;
72             },
73 0         0 );
74             }
75 0 0       0 );
76              
77 0         0 return $websocket->to_app;
78             }
79              
80             sub add
81             {
82 3     3 1 97 my ($self, $type, $sub) = @_;
83              
84 3         7 $type = "on_$type";
85 3         8 my $setter = $self->can($type);
86 3 50       8 croak "unknown websocket event `$type`"
87             unless defined $setter;
88              
89 3         13 return $setter->($self, $sub);
90             }
91              
92             sub get_serializer
93             {
94 0     0 0 0 my ($self) = @_;
95 0 0       0 return undef unless defined $self->serializer;
96              
97 0         0 my $real_serializer_method = $self->app->can($self->serializer);
98 0 0       0 croak "Kelp doesn't have $self->serializer serializer"
99             unless defined $real_serializer_method;
100              
101 0         0 return $real_serializer_method->($self->app);
102             }
103              
104             sub build
105             {
106 1     1 1 92 my ($self, %args) = @_;
107 1         6 $self->SUPER::build(%args);
108 1   33     31 $self->{serializer} = $args{serializer} // $self->serializer;
109              
110 1         13 $self->register(websocket => $self);
111             }
112              
113             1;
114             __END__
115              
116             =head1 NAME
117              
118             Kelp::Module::WebSocket::AnyEvent - AnyEvent websocket server integration with Kelp
119              
120             =head1 SYNOPSIS
121              
122             # in config
123             modules => [qw(Symbiosis WebSocket::AnyEvent)],
124             modules_init => {
125             "WebSocket::AnyEvent" => {
126             serializer => "json",
127             },
128             },
129              
130             # in application's build method
131             my $ws = $self->websocket;
132             $ws->add(message => sub {
133             my ($conn, $msg) = @_;
134             $conn->send({received => $msg});
135             });
136             $self->symbiosis->mount("/ws" => $ws);
137              
138             # in psgi script
139             $app = MyApp->new;
140             $app->run_all;
141              
142              
143             =head1 DESCRIPTION
144              
145             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.
146              
147             =head1 METHODS
148              
149             =head2 connections
150              
151             sig: connections($self)
152              
153             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.
154              
155             =head2 middleware
156              
157             sig: middleware($self)
158              
159             Returns an arrayref of all middlewares in format: C<[ middleware_class, [ middleware_config ] ]>.
160              
161             =head2 psgi
162              
163             sig: psgi($self)
164              
165             Returns a ran instance of L<Plack::App::WebSocket>.
166              
167             =head2 run
168              
169             sig: run($self)
170              
171             Same as psgi, but wraps the instance in all wanted middlewares.
172              
173             =head2 add
174              
175             sig: add($self, $event, $handler)
176              
177             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.
178              
179             =head1 SEE ALSO
180              
181             =over 2
182              
183             =item * L<Dancer2::Plugin::WebSocket>, same integration for Dancer2 framework this module was inspired by
184              
185             =item * L<Kelp>, the framework
186              
187             =item * L<Twiggy>, a server capable of running this websocket
188              
189             =back
190              
191             =head1 AUTHOR
192              
193             Bartosz Jarzyna, E<lt>brtastic.dev@gmail.comE<gt>
194              
195             =head1 COPYRIGHT AND LICENSE
196              
197             Copyright (C) 2020 by Bartosz Jarzyna
198              
199             This library is free software; you can redistribute it and/or modify
200             it under the same terms as Perl itself, either Perl version 5.10.0 or,
201             at your option, any later version of Perl 5 you may have available.
202              
203              
204             =cut