File Coverage

lib/PAGI/Endpoint/WebSocket.pm
Criterion Covered Total %
statement 48 57 84.2
branch 9 14 64.2
condition 1 2 50.0
subroutine 13 15 86.6
pod 3 5 60.0
total 74 93 79.5


line stmt bran cond sub pod time code
1             package PAGI::Endpoint::WebSocket;
2              
3 4     4   509881 use strict;
  4         5  
  4         157  
4 4     4   17 use warnings;
  4         5  
  4         180  
5              
6 4     4   13 use Future::AsyncAwait;
  4         5  
  4         22  
7 4     4   172 use Carp qw(croak);
  4         7  
  4         166  
8 4     4   1195 use Module::Load qw(load);
  4         4254  
  4         17  
9              
10              
11             # Factory class method - override in subclass for customization
12 4     4 1 1637 sub websocket_class { 'PAGI::WebSocket' }
13              
14             # Encoding: 'text', 'bytes', or 'json'
15 3     3 1 1341 sub encoding { 'text' }
16              
17             sub to_app {
18 3     3 1 185356 my ($class) = @_;
19 3         13 my $ws_class = $class->websocket_class;
20 3         9 load($ws_class);
21              
22 1     1   25 return async sub {
23 1         3 my ($scope, $receive, $send) = @_;
24              
25 1   50     5 my $type = $scope->{type} // '';
26 1 50       4 croak "Expected websocket scope, got '$type'" unless $type eq 'websocket';
27              
28 1         11 my $endpoint = $class->new;
29 1         5 my $ws = $ws_class->new($scope, $receive, $send);
30              
31 1         5 await $endpoint->handle($ws, $scope, $send);
32 3         113 };
33             }
34              
35             sub new {
36 4     4 0 355029 my ($class, %args) = @_;
37 4         9 return bless \%args, $class;
38             }
39              
40 3     3 0 12 async sub handle {
41 3         6 my ($self, $ws, $scope, $send) = @_;
42              
43             # Call on_connect if defined
44 3 50       15 if ($self->can('on_connect')) {
45 3         9 await $self->on_connect($ws);
46             } else {
47             # Default: accept the connection
48 0         0 await $ws->accept;
49             }
50              
51             # Register disconnect callback
52 3 100       248 if ($self->can('on_disconnect')) {
53             $ws->on_close(sub {
54 2     2   144 my ($code, $reason) = @_;
55 2         3 $self->on_disconnect($ws, $code, $reason);
56 2         12 });
57             }
58              
59             # Handle messages based on encoding
60 3         12 eval {
61 3 100       9 if ($self->can('on_receive')) {
62 2         7 my $encoding = $self->encoding;
63              
64 2 50       6 if ($encoding eq 'json') {
    50          
65 0     0   0 await $ws->each_json(async sub {
66 0         0 my ($data) = @_;
67 0         0 await $self->on_receive($ws, $data);
68 0         0 });
69             } elsif ($encoding eq 'bytes') {
70 0     0   0 await $ws->each_bytes(async sub {
71 0         0 my ($data) = @_;
72 0         0 await $self->on_receive($ws, $data);
73 0         0 });
74             } else {
75             # Default: text
76 3     3   94 await $ws->each_text(async sub {
77 3         3 my ($data) = @_;
78 3         6 await $self->on_receive($ws, $data);
79 2         8 });
80             }
81             } else {
82             # No on_receive, just wait for disconnect
83 1         3 await $ws->run;
84             }
85             };
86 3 50       98 die $@ if $@;
87             }
88              
89             1;
90              
91             __END__