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   425 use strict;
  1         3  
  1         29  
4 1     1   5 use warnings;
  1         2  
  1         26  
5              
6 1     1   6 use base 'SockJS::Transport::Base';
  1         1  
  1         406  
7              
8             sub new {
9 3     3 0 8037 my $self = shift->SUPER::new(@_);
10              
11 3         7 push @{$self->{allowed_methods}}, 'POST';
  3         7  
12              
13 3         20 return $self;
14             }
15              
16             sub dispatch_POST {
17 3     3 0 18 my $self = shift;
18 3         7 my ($env, $conn) = @_;
19              
20             return sub {
21 3     3   19 my $respond = shift;
22              
23 3 100 66     7 if ($conn->is_connected && !$conn->is_reconnecting) {
24 1         5 $self->_write($env, $respond,
25             'c[2010,"Another connection still open"]');
26 1         53 return;
27             }
28              
29             $conn->write_cb(
30             sub {
31 2         4 my $conn = shift;
32 2         4 my ($message) = @_;
33              
34 2         6 $self->_write($env, $respond, $message);
35 2         10 $conn->reconnecting;
36             }
37 2         11 );
38              
39 2 100       6 if ($conn->is_closed) {
    50          
40 1         7 $conn->connected;
41 1         3 $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         17 };
52             }
53              
54             sub _write {
55 3     3   4 my $self = shift;
56 3         7 my ($env, $respond, $message) = @_;
57              
58 3         6 $message .= "\n";
59              
60 3         13 $respond->(
61             [
62             200, [ 'Content-Type' => 'application/javascript; charset=UTF-8', ],
63             [$message]
64             ]
65             );
66             }
67              
68             1;