File Coverage

blib/lib/Protocol/WebSocket/Client.pm
Criterion Covered Total %
statement 65 68 95.5
branch 12 18 66.6
condition 2 3 66.6
subroutine 13 14 92.8
pod 0 8 0.0
total 92 111 82.8


line stmt bran cond sub pod time code
1             package Protocol::WebSocket::Client;
2              
3 1     1   592 use strict;
  1         2  
  1         24  
4 1     1   4 use warnings;
  1         2  
  1         25  
5              
6             require Carp;
7 1     1   4 use Protocol::WebSocket::URL;
  1         2  
  1         22  
8 1     1   371 use Protocol::WebSocket::Handshake::Client;
  1         2  
  1         21  
9 1     1   3 use Protocol::WebSocket::Frame;
  1         2  
  1         484  
10              
11             sub new {
12 9     9 0 11965 my $class = shift;
13 9 50       22 $class = ref $class if ref $class;
14 9         24 my (%params) = @_;
15              
16 9         12 my $self = {};
17 9         15 bless $self, $class;
18              
19 9 50       18 Carp::croak('url is required') unless $params{url};
20             $self->{url} = Protocol::WebSocket::URL->new->parse($params{url})
21 9 50       28 or Carp::croak("Can't parse url");
22              
23 9         13 $self->{version} = $params{version};
24              
25 9         16 $self->{on_connect} = $params{on_connect};
26 9         12 $self->{on_write} = $params{on_write};
27 9         9 $self->{on_frame} = $params{on_frame};
28 9         14 $self->{on_eof} = $params{on_eof};
29 9         11 $self->{on_error} = $params{on_error};
30              
31             $self->{hs} =
32 9         26 Protocol::WebSocket::Handshake::Client->new(url => $self->{url});
33              
34             my %frame_buffer_params = (
35             max_fragments_amount => $params{max_fragments_amount}
36 9         19 );
37 9 100       19 $frame_buffer_params{max_payload_size} = $params{max_payload_size} if exists $params{max_payload_size};
38              
39 9         20 $self->{frame_buffer} = $self->_build_frame(%frame_buffer_params);
40              
41 9         29 return $self;
42             }
43              
44 0     0 0 0 sub url { shift->{url} }
45 1     1 0 9 sub version { shift->{version} }
46              
47             sub on {
48 7     7 0 40 my $self = shift;
49 7         12 my ($event, $cb) = @_;
50              
51 7         21 $self->{"on_$event"} = $cb;
52              
53 7         10 return $self;
54             }
55              
56             sub read {
57 3     3 0 4 my $self = shift;
58 3         6 my ($buffer) = @_;
59              
60 3         4 my $hs = $self->{hs};
61 3         5 my $frame_buffer = $self->{frame_buffer};
62              
63 3 100       15 unless ($hs->is_done) {
64 2 50       6 if (!$hs->parse($buffer)) {
65 0         0 $self->{on_error}->($self, $hs->error);
66 0         0 return $self;
67             }
68              
69 2 100 66     13 $self->{on_connect}->($self) if $self->{on_connect} && $hs->is_done;
70             }
71              
72 3 50       9 if ($hs->is_done) {
73 3         15 $frame_buffer->append($buffer);
74              
75 3         7 while (my $bytes = $frame_buffer->next) {
76 1         218 $self->{on_read}->($self, $bytes);
77              
78             #$self->{on_frame}->($self, $bytes);
79             }
80             }
81              
82 3         26 return $self;
83             }
84              
85             sub write {
86 1     1 0 4 my $self = shift;
87 1         2 my ($buffer) = @_;
88              
89 1 50       4 my $frame =
90             ref $buffer
91             ? $buffer
92             : $self->_build_frame(masked => 1, buffer => $buffer);
93 1         3 $self->{on_write}->($self, $frame->to_bytes);
94              
95 1         5 return $self;
96             }
97              
98             sub connect {
99 3     3 0 10 my $self = shift;
100              
101 3         4 my $hs = $self->{hs};
102              
103 3         8 $self->{on_write}->($self, $hs->to_string);
104              
105 3         10 return $self;
106             }
107              
108             sub disconnect {
109 1     1 0 5 my $self = shift;
110              
111 1         3 my $frame = $self->_build_frame(type => 'close');
112              
113 1         4 $self->{on_write}->($self, $frame->to_bytes);
114              
115 1         4 return $self;
116             }
117              
118             sub _build_frame {
119 11     11   15 my $self = shift;
120              
121 11         31 return Protocol::WebSocket::Frame->new(version => $self->{version}, @_);
122             }
123              
124             1;
125             __END__