File Coverage

blib/lib/Net/WebSocket/Handshake/Base.pm
Criterion Covered Total %
statement 34 34 100.0
branch 3 6 50.0
condition n/a
subroutine 9 9 100.0
pod 0 1 0.0
total 46 50 92.0


line stmt bran cond sub pod time code
1             package Net::WebSocket::Handshake::Base;
2              
3 2     2   561 use strict;
  2         7  
  2         70  
4 2     2   17 use warnings;
  2         4  
  2         68  
5              
6 2     2   679 use Digest::SHA ();
  2         4641  
  2         44  
7 2     2   481 use Module::Load ();
  2         1701  
  2         42  
8              
9 2     2   11 use constant _WS_MAGIC_CONSTANT => '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';
  2         3  
  2         515  
10              
11             sub create_header_text {
12 1     1 0 11 my $self = shift;
13              
14 1         6 return join( "\x0d\x0a", $self->_create_header_lines(), q<> );
15             }
16              
17             sub _get_accept {
18 1     1   3 my ($self) = @_;
19              
20 1         6 my $key_b64 = $self->{'key'};
21              
22 1         6 $key_b64 =~ s<\A\s+|\s+\z><>g;
23              
24 1         39 my $accept = Digest::SHA::sha1_base64( $key_b64 . _WS_MAGIC_CONSTANT() );
25              
26             #pad base64
27 1         8 $accept .= '=' x (4 - (length($accept) % 4));
28              
29 1         8 return $accept;
30             }
31              
32             sub _encode_subprotocols {
33 1     1   55 my ($self) = @_;
34              
35             return ( $self->{'subprotocols'}
36 1 50       3 ? ( 'Sec-WebSocket-Protocol: ' . join(', ', @{ $self->{'subprotocols'} } ) )
  1         14  
37             : ()
38             );
39             }
40              
41             sub _encode_extensions {
42 1     1   2 my ($self) = @_;
43              
44 1         4 Module::Load::load('HTTP::Headers::Util');
45              
46 1 50       74 return if !$self->{'extensions'};
47 1 50       1 return if !@{ $self->{'extensions'} };
  1         3  
48              
49 1         2 my ($first, @others) = @{ $self->{'extensions'} };
  1         3  
50              
51 1         5 return 'Sec-WebSocket-Extensions: ' . $first->to_string(@others);
52             }
53              
54             1;