File Coverage

blib/lib/Net/WebSocket/PMCE/deflate/Server.pm
Criterion Covered Total %
statement 36 41 87.8
branch 9 14 64.2
condition 2 3 66.6
subroutine 6 7 85.7
pod 1 1 100.0
total 54 66 81.8


line stmt bran cond sub pod time code
1             package Net::WebSocket::PMCE::deflate::Server;
2              
3 1     1   86535 use strict;
  1         13  
  1         30  
4 1     1   5 use warnings;
  1         2  
  1         36  
5              
6             =encoding utf-8
7              
8             =head1 NAME
9              
10             Net::WebSocket::PMCE::deflate::Server - permessage-deflate for a server
11              
12             =head1 SYNOPSIS
13              
14             my $deflate = Net::WebSocket::PMCE::deflate::Server->new( %opts );
15              
16             #You’ll probably want Net::WebSocket::Handshake
17             #to do this for you, but just in case:
18             #$deflate->consume_parameters( @params_kv );
19              
20             #OPTIONAL: Inspect $deflate to be sure you’re happy with the setup
21             #that the client’s parameters allow.
22              
23             #Send this to the client.
24             my $handshake = $deflate->create_handshake_object();
25              
26             #...and now use this to send/receive messages.
27             my $data_obj = $deflate->create_data_object();
28              
29             =head1 DESCRIPTION
30              
31             The above should describe the workflow sufficiently.
32              
33             The optional “inspection” step is to ensure
34             that you’re satisfied with the compression parameters, which may be
35             different now from what you gave to the constructor.
36              
37             For example, if you do this:
38              
39             my $deflate = Net::WebSocket::PMCE::deflate::Server->new(
40             inflate_max_window_bits => 10,
41             );
42              
43             … and then this has no C:
44              
45             $deflate->consume_parameters( @extn_objs );
46              
47             … then that means the client doesn’t understand C,
48             which means we can’t send that parameter. When this happens, C<$deflate>
49             changes to return 15 rather than 10 from its C
50             method.
51              
52             In general this should be fine, but if, for some reason, you want to
53             insist that the client compress with no more than 10 window bits,
54             then at this point you can fail the connection.
55              
56             =cut
57              
58 1         5 use parent qw(
59             Net::WebSocket::PMCE::deflate
60 1     1   422 );
  1         302  
61              
62             use constant {
63 1         480 _ENDPOINT_CLASS => 'Server',
64             _PEER_NO_CONTEXT_TAKEOVER_PARAM => 'client_no_context_takeover',
65             _LOCAL_NO_CONTEXT_TAKEOVER_PARAM => 'server_no_context_takeover',
66             _DEFLATE_MAX_WINDOW_BITS_PARAM => 'server_max_window_bits',
67             _INFLATE_MAX_WINDOW_BITS_PARAM => 'client_max_window_bits',
68 1     1   71 };
  1         2  
69              
70             #----------------------------------------------------------------------
71              
72             #=head1 METHODS
73             #
74             #This inherits all methods from L
75             #and also supplies the following:
76             #
77             #=head2 I->peer_supports_client_max_window_bits()
78             #
79             #Call this after C to ascertain whether the
80             #client indicated support for the C parameter.
81             #
82             #=cut
83             #
84             #sub peer_supports_client_max_window_bits {
85             # my ($self) = @_;
86             # return $self->{'_peer_supports_client_max_window_bits'};
87             #}
88              
89             #----------------------------------------------------------------------
90              
91             #Remove once legacy support goes.
92             sub new {
93 10     10 1 5676 my ($class, @opts_kv) = @_;
94              
95 10         35 my $self = $class->SUPER::new(@opts_kv);
96              
97 6 50       21 $self->_warn_legacy() if $self->{'key'};
98              
99 6         17 return $self;
100             }
101              
102             =head2 I->consume_parameters( KEY1 => VALUE1, .. )
103              
104             Inherited from the base class. The alterations made in response
105             to the different parameters are:
106              
107             =over
108              
109             =item * - Sets the object’s
110             C flag.
111              
112             =item * - Sets the object’s
113             C flag.
114              
115             =item * - If given and less than the object’s
116             C option, then that option is reduced to the
117             new value.
118              
119             =item * - If given and less than the object’s
120             C option, then that option is reduced to the
121             new value.
122              
123             =back
124              
125             =cut
126              
127             sub _create_extension_header_parts {
128 0     0   0 my ($self) = @_;
129              
130 0 0       0 local $self->{'inflate_max_window_bits'} = undef if !$self->{'_peer_supports_client_max_window_bits'};
131              
132 0         0 return $self->SUPER::_create_extension_header_parts();
133             }
134              
135             sub _consume_extension_options {
136 6     6   12 my ($self, $opts_hr) = @_;
137              
138 6         20 for my $ept_opt ( [ client => 'inflate' ], [ server => 'deflate' ] ) {
139 12         25 my $mwb_opt = "$ept_opt->[0]_max_window_bits";
140              
141 12 100       33 if (exists $opts_hr->{$mwb_opt}) {
142 3 100       10 if ($ept_opt->[0] eq 'client') {
143 1         2 $self->{'_peer_supports_client_max_window_bits'} = 1;
144              
145 1 50       5 if (!defined $opts_hr->{$mwb_opt}) {
146 0         0 delete $opts_hr->{$mwb_opt};
147 0         0 next;
148             }
149             }
150              
151 3         6 my $self_opt = "$ept_opt->[1]_max_window_bits";
152 3         12 $self->__validate_max_window_bits($ept_opt->[0], $opts_hr->{$mwb_opt});
153              
154 3   66     15 my $max = $self->{$self_opt} || ( $self->VALID_MAX_WINDOW_BITS() )[-1];
155              
156 3 50       52 if ($opts_hr->{$mwb_opt} < $max) {
157 3         9 $self->{$self_opt} = $opts_hr->{$mwb_opt};
158             }
159              
160             #If the client requested a greater server_max_window_bits than
161             #we want, that’s no problem, but we’re just going to ignore it.
162              
163 3         29 delete $opts_hr->{$mwb_opt};
164             }
165             }
166              
167 6         24 for my $ept_opt ( [ client => 'inflate' ], [ server => 'deflate' ] ) {
168 12         26 my $nct_hdr = "$ept_opt->[0]_no_context_takeover";
169              
170 12 100       27 if (exists $opts_hr->{$nct_hdr}) {
171 3         14 $self->__validate_no_context_takeover( $ept_opt->[0], $opts_hr->{$nct_hdr} );
172              
173 3         10 $self->{"$ept_opt->[1]_no_context_takeover"} = 1;
174              
175 3         7 delete $opts_hr->{$nct_hdr};
176             }
177             }
178              
179 6         15 return;
180             }
181              
182             1;