File Coverage

blib/lib/SockJS/Transport/JSONPPolling.pm
Criterion Covered Total %
statement 47 49 95.9
branch 10 12 83.3
condition 2 3 66.6
subroutine 7 7 100.0
pod 0 2 0.0
total 66 73 90.4


line stmt bran cond sub pod time code
1             package SockJS::Transport::JSONPPolling;
2              
3 1     1   438 use strict;
  1         2  
  1         27  
4 1     1   5 use warnings;
  1         1  
  1         27  
5              
6 1     1   4 use base 'SockJS::Transport::Base';
  1         2  
  1         413  
7              
8             sub new {
9 6     6 0 15054 my $self = shift->SUPER::new(@_);
10              
11 6         9 push @{$self->{allowed_methods}}, 'GET';
  6         13  
12              
13 6         31 return $self;
14             }
15              
16             sub dispatch_GET {
17 6     6 0 8 my $self = shift;
18 6         15 my ($env, $conn, $path) = @_;
19              
20 6         43 my ($callback) = $env->{QUERY_STRING} =~ m/(?:^|&|;)c=([^&;]+)/;
21 6 100       15 if (!$callback) {
22 1         5 return [500, [], ['"callback" parameter required']];
23             }
24              
25 5         17 $callback =~ s/%(..)/chr(hex($1))/eg;
  0         0  
26 5 100       17 if ($callback !~ m/^[a-zA-Z0-9-_\.]+$/) {
27 1         6 return [500, [], ['invalid "callback" parameter']];
28             }
29              
30             return sub {
31 4     4   531 my $respond = shift;
32              
33 4         15 my $writer = $respond->(
34             [ 200,
35             [ 'Content-Type' => 'application/javascript; charset=UTF-8',
36             'Connection' => 'close',
37             ]
38             ]
39             );
40              
41 4 100 66     29 if ($conn->is_connected && !$conn->is_reconnecting) {
42 1         4 my $message = $self->_wrap_message($callback,
43             'c[2010,"Another connection still open"]' . "\n");
44 1         20 $writer->write($message);
45 1         70 $writer->close;
46 1         40 return;
47             }
48              
49             $conn->write_cb(
50             sub {
51 3         4 my $conn = shift;
52 3         7 my ($message) = @_;
53              
54 3         7 $message = $self->_wrap_message($callback, $message);
55              
56 3         37 $writer->write($message);
57 3         208 $writer->write('');
58 3         147 $writer->close;
59              
60 3 50       115 $conn->reconnecting if $conn->is_connected;
61             }
62 3         24 );
63              
64 3 100       7 if ($conn->is_closed) {
    50          
65 1         3 $conn->connected;
66 1         2 $conn->close;
67             }
68             elsif ($conn->is_connected) {
69 0         0 $conn->reconnected;
70             }
71             else {
72 2         5 $conn->write('o');
73              
74 2         6 $conn->connected;
75             }
76 4         21 };
77             }
78              
79             sub _wrap_message {
80 4     4   7 my $self = shift;
81 4         9 my ($callback, $message) = @_;
82              
83 4         29 $message =~ s/(['""\\\/\n\r\t]{1})/\\$1/smg;
84 4         12 $message = qq{/**/$callback("$message");\r\n};
85              
86 4         10 return $message;
87             }
88              
89             1;