File Coverage

blib/lib/Net/WebSocket/HTTP_R.pm
Criterion Covered Total %
statement 20 21 95.2
branch 1 2 50.0
condition n/a
subroutine 5 5 100.0
pod 0 2 0.0
total 26 30 86.6


line stmt bran cond sub pod time code
1             package Net::WebSocket::HTTP_R;
2              
3 1     1   74892 use strict;
  1         9  
  1         23  
4 1     1   4 use warnings;
  1         1  
  1         167  
5              
6             =encoding utf-8
7              
8             =head1 NAME
9              
10             Net::WebSocket::HTTP_R - logic for HTTP::Request & HTTP::Response
11              
12             =head1 SYNOPSIS
13              
14             Client:
15              
16             my $resp = HTTP::Response->parse_string($http_response);
17              
18             my $handshake = Net::WebSocket::Handshake::Client->new( .. );
19              
20             Net::WebSocket::HTTP_R::handshake_consume_response( $handshake, $resp );
21              
22             Server:
23              
24             my $req = HTTP::Request->parse_string($http_request);
25              
26             my $handshake = Net::WebSocket::Handshake::Server->new( .. );
27              
28             Net::WebSocket::HTTP_R::handshake_consume_request( $handshake, $req );
29              
30             =head1 DESCRIPTION
31              
32             Net::WebSocket is agnostic as to which tools an implementor may use to parse
33             HTTP headers. CPAN offers a number of options for doing this, and different
34             applications may have varying reasons to prefer one or the other—or an
35             entirely different approach altogether.
36              
37             This module provides convenient logic for the L and
38             L CPAN modules. Any implementation that uses one of these
39             modules (or a compatible implementation) can use Net::WebSocket::HTTP_R and
40             save a bit of time.
41              
42             =cut
43              
44             sub handshake_consume_request {
45 1     1 0 7 my ($hsk, $req) = @_;
46              
47 1         4 $hsk->valid_method_or_die( $req->method() );
48              
49 1         4 return _handshake_consume_common($hsk, $req);
50             }
51              
52             sub handshake_consume_response {
53 1     1 0 256 my ($hsk, $resp) = @_;
54              
55 1         3 $hsk->valid_status_or_die( $resp->code(), $resp->message() );
56              
57 1         2 return _handshake_consume_common($hsk, $resp);
58             }
59              
60             sub _handshake_consume_common {
61 2     2   5 my ($hsk, $r_obj) = @_;
62              
63 2         9 my $hdrs_obj = $r_obj->headers();
64              
65 2         12 my @hdrs;
66 2         7 for my $hname ($hdrs_obj->header_field_names()) {
67 10         109 my $value = $hdrs_obj->header($hname);
68 10 50       267 if ('ARRAY' eq ref $value) {
69 0         0 push @hdrs, $hname => $_ for @$value;
70             }
71             else {
72 10         21 push @hdrs, $hname => $value;
73             }
74             }
75              
76 2         15 return $hsk->consume_headers(@hdrs);
77             }
78              
79             1;