File Coverage

blib/lib/SockJS/Transport/XHRPolling.pm
Criterion Covered Total %
statement 34 35 97.1
branch 5 6 83.3
condition 2 3 66.6
subroutine 7 7 100.0
pod 0 2 0.0
total 48 53 90.5


line stmt bran cond sub pod time code
1             package SockJS::Transport::XHRPolling;
2              
3 1     1   457 use strict;
  1         2  
  1         31  
4 1     1   4 use warnings;
  1         3  
  1         27  
5              
6 1     1   4 use base 'SockJS::Transport::Base';
  1         2  
  1         424  
7              
8             sub new {
9 3     3 0 15439 my $self = shift->SUPER::new(@_);
10              
11 3         6 push @{$self->{allowed_methods}}, 'POST';
  3         7  
12              
13 3         18 return $self;
14             }
15              
16             sub dispatch_POST {
17 3     3 0 15 my $self = shift;
18 3         8 my ($env, $conn) = @_;
19              
20             return sub {
21 3     3   15 my $respond = shift;
22              
23 3 100 66     13 if ($conn->is_connected && !$conn->is_reconnecting) {
24 1         4 $self->_write($env, $respond,
25             'c[2010,"Another connection still open"]');
26 1         4 return;
27             }
28              
29             $conn->write_cb(
30             sub {
31 2         2 my $conn = shift;
32 2         5 my ($message) = @_;
33              
34 2         5 $self->_write($env, $respond, $message);
35 2         9 $conn->reconnecting;
36             }
37 2         11 );
38              
39 2 100       12 if ($conn->is_closed) {
    50          
40 1         4 $conn->connected;
41 1         2 $conn->close;
42             }
43             elsif ($conn->is_connected) {
44 0         0 $conn->reconnected;
45             }
46             else {
47 1         3 $conn->write('o');
48              
49 1         3 $conn->connected;
50             }
51 3         15 };
52             }
53              
54             sub _write {
55 3     3   4 my $self = shift;
56 3         7 my ($env, $respond, $message) = @_;
57              
58 3         4 $message .= "\n";
59              
60 3         12 $respond->(
61             [
62             200, [ 'Content-Type' => 'application/javascript; charset=UTF-8', ],
63             [$message]
64             ]
65             );
66             }
67              
68             1;