File Coverage

blib/lib/PAGI/Endpoint/WebSocket.pm
Criterion Covered Total %
statement 46 55 83.6
branch 9 14 64.2
condition 1 2 50.0
subroutine 12 14 85.7
pod 3 5 60.0
total 71 90 78.8


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