File Coverage

blib/lib/PocketIO/Resource.pm
Criterion Covered Total %
statement 78 101 77.2
branch 9 16 56.2
condition 9 11 81.8
subroutine 20 23 86.9
pod 2 2 100.0
total 118 153 77.1


line stmt bran cond sub pod time code
1             package PocketIO::Resource;
2              
3 6     6   605 use strict;
  6         13  
  6         207  
4 6     6   30 use warnings;
  6         12  
  6         149  
5              
6 6     6   8070 use Protocol::SocketIO::Handshake;
  6         2120  
  6         1288  
7 6     6   8183 use Protocol::SocketIO::Path;
  6         2973  
  6         196  
8              
9 6     6   533 use PocketIO::Exception;
  6         15  
  6         177  
10 6     6   4691 use PocketIO::Transport::Htmlfile;
  6         18  
  6         168  
11 6     6   6294 use PocketIO::Transport::JSONPPolling;
  6         17  
  6         250  
12 6     6   7645 use PocketIO::Transport::WebSocket;
  6         25  
  6         228  
13 6     6   5352 use PocketIO::Transport::XHRMultipart;
  6         19  
  6         165  
14 6     6   4224 use PocketIO::Transport::XHRPolling;
  6         21  
  6         165  
15 6     6   40 use PocketIO::Util;
  6         14  
  6         6004  
16              
17 6     6   36 use constant DEBUG => $ENV{POCKETIO_RESOURCE_DEBUG};
  6         11  
  6         6910  
18              
19             my %TRANSPORTS = (
20             'flashsocket' => 'WebSocket',
21             'htmlfile' => 'Htmlfile',
22             'jsonp-polling' => 'JSONPPolling',
23             'websocket' => 'WebSocket',
24              
25             # 'xhr-multipart' => 'XHRMultipart',
26             'xhr-polling' => 'XHRPolling',
27             );
28              
29             sub new {
30 6     6 1 34 my $class = shift;
31              
32 6         19 my $self = {@_};
33 6         16 bless $self, $class;
34              
35 6   100     39 $self->{heartbeat_timeout} ||= 15;
36 6   100     26 $self->{close_timeout} ||= 25;
37 6   50     33 $self->{max_connections} ||= 100;
38              
39 6   50     40 $self->{transports}
40             ||= [qw/websocket flashsocket htmlfile xhr-polling jsonp-polling/];
41              
42 6         23 return $self;
43             }
44              
45             sub dispatch {
46 8     8 1 583 my $self = shift;
47 8         14 my ($env, $cb) = @_;
48              
49 8         316 my $method = $env->{REQUEST_METHOD};
50              
51 8 100 100     56 PocketIO::Exception->throw(400 => 'Unexpected method')
52             unless $method eq 'POST' || $method eq 'GET';
53              
54 7         13 my $path_info = $env->{PATH_INFO};
55              
56 7         56 my $path =
57             Protocol::SocketIO::Path->new(transports => $self->{transports})
58             ->parse($path_info);
59 7 100       262 PocketIO::Exception->throw(400 => 'Cannot parse path') unless $path;
60              
61 6 100       24 if ($path->is_handshake) {
62 5         48 return $self->_dispatch_handshake($env, $cb);
63             }
64              
65 1         12 my $conn = $self->_find_connection($path->session_id);
66 1 50       7 PocketIO::Exception->throw(400 => 'Unknown session id') unless $conn;
67              
68             my $transport = $self->_build_transport(
69             $path->transport_type,
70             env => $env,
71             conn => $conn,
72             handle => $self->_build_handle($env),
73 0     0   0 on_disconnect => sub { $self->{pool}->remove_connection($conn) }
74 0         0 );
75              
76 0         0 $conn->type($path->transport_type);
77              
78 0 0       0 my $dispatch = eval { $transport->dispatch } or do {
  0         0  
79 0         0 my $e = $@;
80 0         0 warn $e if DEBUG;
81 0         0 die $e;
82             };
83              
84 0         0 return $dispatch;
85             }
86              
87             sub _build_handle {
88 0     0   0 my $self = shift;
89 0         0 my ($env) = @_;
90              
91 0         0 return PocketIO::Handle->new(
92             heartbeat_timeout => $self->{heartbeat_timeout},
93             fh => $env->{'psgix.io'}
94             );
95             }
96              
97             sub _dispatch_handshake {
98 5     5   8 my $self = shift;
99 5         8 my ($env, $cb) = @_;
100              
101             return sub {
102 2     2   15 my $respond = shift;
103              
104             eval {
105 2         9 $self->_build_connection(
106             on_connect => $cb,
107             on_connect_args => [$env],
108             $self->_on_connection_created($env, $respond)
109             );
110              
111 2         23 1;
112 2 50       2 } or do {
113 0         0 my $e = $@;
114              
115 0         0 warn "Handshake error: $e";
116              
117 0         0 PocketIO::Exception->throw(503 => 'Service unavailable');
118             };
119 5         73 };
120             }
121              
122             sub _build_connection {
123 2     2   4 my $self = shift;
124              
125 2         8 $self->{pool}->add_connection(@_);
126             }
127              
128             sub _on_connection_created {
129 2     2   2 my $self = shift;
130 2         3 my ($env, $respond) = @_;
131              
132             return sub {
133 2     2   3 my $conn = shift;
134              
135 2         7 my $handshake = Protocol::SocketIO::Handshake->new(
136             session_id => $conn->id,
137             transports => $self->{transports},
138             heartbeat_timeout => $self->{heartbeat_timeout},
139             close_timeout => $self->{close_timeout}
140             )->to_bytes;
141              
142 2         83 my $headers = [];
143              
144 2         10 my $jsonp =
145             PocketIO::Util::urlencoded_param($env->{QUERY_STRING}, 'jsonp');
146              
147             # XDomain request
148 2 50       6 if (defined $jsonp) {
149 0         0 push @$headers, 'Content-Type' => 'application/javascript';
150 0         0 $handshake = qq{io.j[$jsonp]("$handshake");};
151             }
152             else {
153 2         4 push @$headers, 'Content-Type' => 'text/plain';
154             }
155              
156 2         4 push @$headers, 'Connection' => 'keep-alive';
157 2         5 push @$headers, 'Content-Length' => length($handshake);
158              
159 2         9 $respond->([200, $headers, [$handshake]]);
160 2         11 };
161             }
162              
163             sub _find_connection {
164 1     1   8 my $self = shift;
165              
166 1         5 return $self->{pool}->find_connection(@_);
167             }
168              
169             sub _build_transport {
170 0     0     my $self = shift;
171 0           my ($type, @args) = @_;
172              
173 0 0         PocketIO::Exception->throw(400 => 'Transport building failed')
174             unless exists $TRANSPORTS{$type};
175              
176 0           my $class = "PocketIO::Transport::$TRANSPORTS{$type}";
177              
178 0           DEBUG && warn "Building $class\n";
179              
180 0           return $class->new(@args);
181             }
182              
183             1;
184             __END__