File Coverage

blib/lib/Net/WebSocket/Handshake/Extension.pm
Criterion Covered Total %
statement 25 31 80.6
branch n/a
condition n/a
subroutine 9 10 90.0
pod 5 5 100.0
total 39 46 84.7


line stmt bran cond sub pod time code
1             package Net::WebSocket::Handshake::Extension;
2              
3 5     5   298 use strict;
  5         10  
  5         117  
4 5     5   21 use warnings;
  5         9  
  5         93  
5              
6 5     5   646 use Call::Context ();
  5         595  
  5         71  
7              
8             #We use this because it’s light; there seems little reason why
9             #we’d want to use anything else?
10 5     5   997 use HTTP::Headers::Util ();
  5         2851  
  5         1065  
11              
12             =encoding utf-8
13              
14             =head1 NAME
15              
16             Net::WebSocket::Handshake::Extension - WebSocket extension handshake
17              
18             =head1 SYNOPSIS
19              
20             #Returns a list of instances of this class
21             my @exts = Net::WebSocket::Handshake::Extension->parse_string(
22             $value_of_sec_websocket_extensions
23             );
24              
25             my $ext = Net::WebSocket::Handshake::Extension->new(
26             'extension-name',
27             param1 => 'value1',
28             #...
29             );
30              
31             my $name = $ext->token(); #e.g., 'extension-name'
32              
33             my @params = $ext->parameters();
34              
35             #@others is an array of instances of this class
36             my $str = $ext->to_string(@others);
37              
38             =head1 DESCRIPTION
39              
40             This module handles the handshake component of WebSocket extensions:
41             specifically, it translates between an extension name and parameters
42             as an object and as actually represented in the values of HTTP headers.
43              
44             It’s flexible enough that you can determine how you want extensions
45             divided among multiple C headers.
46              
47             Note that a server, as per the protocol specification, “MUST NOT”
48             include more than one C header in its
49             handshake response.
50              
51             =head1 METHODS
52              
53             =head2 @objects = I->parse_string( HEADER_VALUE )
54              
55             Parses the value of the C header (i.e., HEADER_VALUE)
56             into one or more instances of this class.
57              
58             =cut
59              
60             sub parse_string {
61 0     0 1 0 my ($class, $str) = @_;
62              
63 0         0 Call::Context::must_be_list();
64              
65 0         0 my @pieces = HTTP::Headers::Util::split_header_words($str);
66 0         0 splice(@$_, 1, 1) for @pieces;
67              
68 0         0 return map { $class->new(@$_) } @pieces;
  0         0  
69             }
70              
71             =head2 I->new( NAME, PARAMS_KV )
72              
73             Returns an instance of the class, with NAME as the C value and
74             PARAMS_KV as C. Probably less useful than C.
75              
76             =cut
77              
78             sub new {
79 6     6 1 709 my ($class, @name_and_params) = @_;
80              
81 6         18 return bless \@name_and_params, $class;
82             }
83              
84             =head2 I->token()
85              
86             Returns the token as given in the C header.
87              
88             =cut
89              
90 2     2 1 10 sub token { return $_[0][0] }
91              
92             =head2 %params = I->parameters()
93              
94             Returns the parameters as given in the C header.
95             The parameters are a list of key/value pairs, suitable for representation
96             as a hash. Parameters that have no value (e.g., the C
97             extension’s C parameter) are given undef as a
98             Perl value.
99              
100             =cut
101              
102             sub parameters {
103 4     4 1 12 Call::Context::must_be_list();
104 4         31 return @{ $_[0] }[ 1 .. $#{ $_[0] } ];
  4         17  
  4         17  
105             }
106              
107             =head2 I->to_string( OTHER_EXTENSIONS )
108              
109             Returns a string that represents the extension (and any others) as a
110             C header value. Other extensions are to be given
111             as instances of this class.
112              
113             =cut
114              
115             sub to_string {
116 1     1 1 3 my ($self, @others) = @_;
117              
118             return HTTP::Headers::Util::join_header_words(
119 1         3 ( map { $_->_to_arrayref() } $self, @others ),
  2         5  
120             );
121             }
122              
123             #----------------------------------------------------------------------
124              
125             sub _to_arrayref {
126 2     2   3 return [ $_[0][0] => undef, @{ $_[0] }[ 1 .. $#{ $_[0] } ] ];
  2         9  
  2         5  
127             }
128              
129             1;