File Coverage

blib/lib/Net/WebSocket/PingStore.pm
Criterion Covered Total %
statement 20 21 95.2
branch 1 2 50.0
condition n/a
subroutine 8 8 100.0
pod 0 4 0.0
total 29 35 82.8


line stmt bran cond sub pod time code
1             package Net::WebSocket::PingStore;
2              
3             #----------------------------------------------------------------------
4             # This isn’t really meant for public consumption, but it is at least
5             # useful in Net::WAMP for implementing the same behavior as WebSocket uses.
6             #----------------------------------------------------------------------
7              
8 9     9   46 use strict;
  9         12  
  9         196  
9 9     9   107 use warnings;
  9         18  
  9         2116  
10              
11 8     8 0 39 sub new { return bless { }, shift; }
12              
13             sub add {
14 10     10 0 17 my ($self) = @_;
15              
16 10         19 my $str = $self->_generate_text();
17              
18 10         42 return $self->{$str} = $str;
19             }
20              
21             #NB: We expect a response to any ping that we’ve sent; any pong
22             #we receive that doesn’t actually correlate to a ping we’ve sent
23             #is ignored—i.e., it doesn’t reset the ping counter. This means that
24             #we could still timeout even if we’re receiving pongs.
25             sub remove {
26 1     1 0 3 my ($self, $text) = @_;
27              
28 1 50       4 if ( delete $self->{$text} ) {
29 1         3 $self->_reset();
30 1         3 return 1;
31             }
32              
33 0         0 return 0;
34             }
35              
36             sub get_count {
37 20     20 0 29 my ($self) = @_;
38              
39 20         132 return 0 + keys %$self;
40             }
41              
42             #----------------------------------------------------------------------
43              
44             sub _generate_text {
45 10     10   12 my ($self) = @_;
46              
47 10         90 return sprintf(
48             '%s UTC: ping #%d (%x)',
49             scalar(gmtime),
50             1 + $self->get_count(),
51             substr(rand, 2),
52             );
53             }
54              
55             sub _reset {
56 1     1   11 my ($self) = @_;
57              
58 1         4 return %$self = ();
59             }
60              
61             1;