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   55024 use strict;
  1         10  
  1         22  
4 1     1   5 use warnings;
  1         2  
  1         29  
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             =back
57              
58             =cut
59              
60 1         4 use parent qw(
61             Net::WebSocket::PMCE::deflate
62 1     1   229 );
  1         216  
63              
64             use constant {
65 1         336 _ENDPOINT_CLASS => 'Server',
66             _PEER_NO_CONTEXT_TAKEOVER_PARAM => 'client_no_context_takeover',
67             _LOCAL_NO_CONTEXT_TAKEOVER_PARAM => 'server_no_context_takeover',
68             _DEFLATE_MAX_WINDOW_BITS_PARAM => 'server_max_window_bits',
69             _INFLATE_MAX_WINDOW_BITS_PARAM => 'client_max_window_bits',
70 1     1   49 };
  1         1  
71              
72             #----------------------------------------------------------------------
73              
74             #=head1 METHODS
75             #
76             #This inherits all methods from L
77             #and also supplies the following:
78             #
79             #=head2 I->peer_supports_client_max_window_bits()
80             #
81             #Call this after C to ascertain whether the
82             #client indicated support for the C parameter.
83             #
84             #=cut
85             #
86             #sub peer_supports_client_max_window_bits {
87             # my ($self) = @_;
88             # return $self->{'_peer_supports_client_max_window_bits'};
89             #}
90              
91             #----------------------------------------------------------------------
92              
93             #Remove once legacy support goes.
94             sub new {
95 10     10 1 3510 my ($class, @opts_kv) = @_;
96              
97 10         34 my $self = $class->SUPER::new(@opts_kv);
98              
99 6 50       16 $self->_warn_legacy() if $self->{'key'};
100              
101 6         13 return $self;
102             }
103              
104             =head2 I->consume_parameters( KEY1 => VALUE1, .. )
105              
106             Inherited from the base class. The alterations made in response
107             to the different parameters are:
108              
109             =over
110              
111             =item * - Sets the object’s
112             C flag.
113              
114             =item * - Sets the object’s
115             C flag.
116              
117             =item * - If given and less than the object’s
118             C option, then that option is reduced to the
119             new value.
120              
121             =item * - If given and less than the object’s
122             C option, then that option is reduced to the
123             new value.
124              
125             =back
126              
127             =cut
128              
129             sub _create_extension_header_parts {
130 0     0   0 my ($self) = @_;
131              
132 0 0       0 local $self->{'inflate_max_window_bits'} = undef if !$self->{'_peer_supports_client_max_window_bits'};
133              
134 0         0 return $self->SUPER::_create_extension_header_parts();
135             }
136              
137             sub _consume_extension_options {
138 6     6   11 my ($self, $opts_hr) = @_;
139              
140 6         16 for my $ept_opt ( [ client => 'inflate' ], [ server => 'deflate' ] ) {
141 12         22 my $mwb_opt = "$ept_opt->[0]_max_window_bits";
142              
143 12 100       25 if (exists $opts_hr->{$mwb_opt}) {
144 3 100       8 if ($ept_opt->[0] eq 'client') {
145 1         2 $self->{'_peer_supports_client_max_window_bits'} = 1;
146              
147 1 50       3 if (!defined $opts_hr->{$mwb_opt}) {
148 0         0 delete $opts_hr->{$mwb_opt};
149 0         0 next;
150             }
151             }
152              
153 3         6 my $self_opt = "$ept_opt->[1]_max_window_bits";
154 3         11 $self->__validate_max_window_bits($ept_opt->[0], $opts_hr->{$mwb_opt});
155              
156 3   66     11 my $max = $self->{$self_opt} || ( $self->VALID_MAX_WINDOW_BITS() )[-1];
157              
158 3 50       20 if ($opts_hr->{$mwb_opt} < $max) {
159 3         6 $self->{$self_opt} = $opts_hr->{$mwb_opt};
160             }
161              
162             #If the client requested a greater server_max_window_bits than
163             #we want, that’s no problem, but we’re just going to ignore it.
164              
165 3         20 delete $opts_hr->{$mwb_opt};
166             }
167             }
168              
169 6         19 for my $ept_opt ( [ client => 'inflate' ], [ server => 'deflate' ] ) {
170 12         20 my $nct_hdr = "$ept_opt->[0]_no_context_takeover";
171              
172 12 100       23 if (exists $opts_hr->{$nct_hdr}) {
173 3         11 $self->__validate_no_context_takeover( $ept_opt->[0], $opts_hr->{$nct_hdr} );
174              
175 3         6 $self->{"$ept_opt->[1]_no_context_takeover"} = 1;
176              
177 3         8 delete $opts_hr->{$nct_hdr};
178             }
179             }
180              
181 6         14 return;
182             }
183              
184             1;