File Coverage

blib/lib/Plack/Middleware/SocketIO/Htmlfile.pm
Criterion Covered Total %
statement 12 60 20.0
branch 0 8 0.0
condition 0 3 0.0
subroutine 4 10 40.0
pod 0 2 0.0
total 16 83 19.2


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