File Coverage

blib/lib/Net/Async/WebSocket/Protocol.pm
Criterion Covered Total %
statement 33 33 100.0
branch 2 2 100.0
condition n/a
subroutine 9 9 100.0
pod 3 3 100.0
total 47 47 100.0


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2010-2015 -- leonerd@leonerd.org.uk
5              
6             package Net::Async::WebSocket::Protocol;
7              
8 4     4   1029 use strict;
  4         8  
  4         98  
9 4     4   19 use warnings;
  4         6  
  4         108  
10 4     4   17 use base qw( IO::Async::Stream );
  4         8  
  4         2977  
11              
12 4     4   156475 use Carp;
  4         10  
  4         359  
13              
14             our $VERSION = '0.10';
15              
16 4     4   3515 use Protocol::WebSocket::Frame;
  4         13178  
  4         1202  
17              
18             =head1 NAME
19              
20             C - send and receive WebSocket frames
21              
22             =head1 DESCRIPTION
23              
24             This subclass of L implements an established WebSocket
25             connection, that has already completed its setup handshaking and is ready to
26             pass frames.
27              
28             Objects of this type would not normally be constructed directly. For WebSocket
29             clients, see L, which is a subclass of this.
30             For WebSocket servers, see L, which constructs
31             objects in this class when it accepts a new connection and passes it to its
32             event handler.
33              
34             =cut
35              
36             sub _init
37             {
38 4     4   12519 my $self = shift;
39 4         33 $self->SUPER::_init;
40              
41 4         121 $self->{framebuffer} = Protocol::WebSocket::Frame->new;
42             }
43              
44             =head1 PARAMETERS
45              
46             The following named parameters may be passed to C or C:
47              
48             =over 8
49              
50             =item on_frame => CODE
51              
52             A CODE reference for when a frame is received
53              
54             $on_frame->( $self, $frame )
55              
56             =back
57              
58             =cut
59              
60             sub configure
61             {
62 18     18 1 1404 my $self = shift;
63 18         43 my %params = @_;
64              
65 18         40 foreach (qw( on_frame )) {
66 18 100       70 $self->{$_} = delete $params{$_} if exists $params{on_frame};
67             }
68              
69 18         78 $self->SUPER::configure( %params );
70             }
71              
72             my %FRAMETYPES = (
73             1 => "text",
74             2 => "binary",
75             0x8 => "close",
76             0x9 => "ping",
77             0xa => "pong",
78             );
79              
80             sub on_read
81             {
82 5     5 1 7891 my $self = shift;
83 5         11 my ( $buffref, $closed ) = @_;
84              
85 5         11 my $framebuffer = $self->{framebuffer};
86              
87 5         50 $framebuffer->append( $$buffref ); # modifies $$buffref
88              
89 5         63 while( defined( my $frame = $framebuffer->next ) ) {
90 5         1098 $self->debug_printf( "FRAME " . $FRAMETYPES{$framebuffer->opcode} );
91              
92 5         63 $self->invoke_event( on_frame => $frame );
93             }
94              
95 5         157 return 0;
96             }
97              
98             =head1 METHODS
99              
100             The following methods documented with a trailing call to C<< ->get >> return
101             L instances.
102              
103             =cut
104              
105             =head2 send_frame
106              
107             $self->send_frame( @args )->get
108              
109             Sends a frame to the peer containing containing the given string. The
110             arguments are passed to L's C method.
111              
112             =cut
113              
114             sub send_frame
115             {
116 4     4 1 1750 my $self = shift;
117              
118 4         26 $self->write( Protocol::WebSocket::Frame->new( @_ )->to_bytes );
119             }
120              
121             =head1 AUTHOR
122              
123             Paul Evans
124              
125             =cut
126              
127             0x55AA;