File Coverage

blib/lib/Plack/Middleware/SocketIO/XHRPolling.pm
Criterion Covered Total %
statement 9 55 16.3
branch 0 12 0.0
condition 0 3 0.0
subroutine 3 9 33.3
pod 2 2 100.0
total 14 81 17.2


line stmt bran cond sub pod time code
1             package Plack::Middleware::SocketIO::XHRPolling;
2              
3 1     1   5 use strict;
  1         1  
  1         25  
4 1     1   4 use warnings;
  1         3  
  1         21  
5              
6 1     1   3 use base 'Plack::Middleware::SocketIO::Base';
  1         1  
  1         651  
7              
8 0     0 1   sub name {'xhr-polling'}
9              
10             sub finalize {
11 0     0 1   my $self = shift;
12 0           my ($cb) = @_;
13              
14 0           my $req = $self->req;
15 0           my $resource = $self->resource;
16 0           my $name = $self->name;
17              
18 0 0         if ($req->method eq 'GET') {
19 0 0         return $self->_finalize_init($cb)
20             if $req->path =~ m{^/$resource/$name//\d+$};
21              
22 0 0         return $self->_finalize_stream($1)
23             if $req->path =~ m{^/$resource/$name/(\d+)/\d+$};
24             }
25              
26             return
27 0 0 0       unless $req->method eq 'POST'
28             && $req->path_info =~ m{^/$resource/$name/(\d+)/send$};
29              
30 0           return $self->_finalize_send($req, $1);
31             }
32              
33             sub _finalize_init {
34 0     0     my $self = shift;
35 0           my ($cb) = @_;
36              
37 0           my $conn = $self->add_connection(on_connect => $cb);
38              
39 0           my $body = $conn->build_id_message;
40              
41             return [
42 0           200,
43             [ 'Content-Type' => 'text/plain',
44             'Content-Length' => length($body),
45             'Connection' => 'keep-alive'
46             ],
47             [$body]
48             ];
49             }
50              
51             sub _finalize_stream {
52 0     0     my $self = shift;
53 0           my ($id) = @_;
54              
55 0           my $conn = $self->find_connection_by_id($id);
56 0 0         return unless $conn;
57              
58 0           my $handle = $self->_build_handle($self->env->{'psgix.io'});
59              
60             return sub {
61 0     0     my $respond = shift;
62              
63             $handle->on_eof(
64             sub {
65 0           $self->client_disconnected($conn);
66              
67 0           $handle->close;
68             }
69 0           );
70              
71             $handle->on_error(
72             sub {
73 0           $self->client_disconnected($conn);
74              
75 0           $handle->close;
76             }
77 0           );
78              
79 0           $handle->heartbeat_timeout(10);
80 0           $handle->on_heartbeat(sub { $conn->send_heartbeat });
  0            
81              
82             $conn->on_write(
83             sub {
84 0           my $self = shift;
85 0           my ($message) = @_;
86              
87 0           $handle->write(
88             join "\x0d\x0a" => 'HTTP/1.1 200 OK',
89             'Content-Type: text/plain',
90             'Content-Length: ' . length($message), '', $message
91             );
92              
93             # TODO: set reconnect timeout
94              
95 0           $handle->close;
96             }
97 0           );
98              
99 0           $self->client_connected($conn);
100 0           };
101             }
102              
103             sub _finalize_send {
104 0     0     my $self = shift;
105 0           my ($req, $id) = @_;
106              
107 0           my $conn = $self->find_connection_by_id($id);
108 0 0         return unless $conn;
109              
110 0           my $retval = [
111             200,
112             [ 'Content-Type' => 'text/plain',
113             'Transfer-Encoding' => 'chunked'
114             ],
115             ["2\x0d\x0aok\x0d\x0a" . "0\x0d\x0a\x0d\x0a"]
116             ];
117              
118 0           my $data = $req->body_parameters->get('data');
119              
120 0           $conn->read($data);
121              
122 0           return $retval;
123             }
124              
125             1;
126             __END__