File Coverage

blib/lib/Net/WebSocket/PingStore.pm
Criterion Covered Total %
statement 7 21 33.3
branch 0 2 0.0
condition n/a
subroutine 3 8 37.5
pod 0 4 0.0
total 10 35 28.5


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 1     1   5 use strict;
  1         2  
  1         21  
9 1     1   4 use warnings;
  1         2  
  1         171  
10              
11 1     1 0 4 sub new { return bless { }, shift; }
12              
13             sub add {
14 0     0 0   my ($self) = @_;
15              
16 0           my $str = $self->_generate_text();
17              
18 0           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 0     0 0   my ($self, $text) = @_;
27              
28 0 0         if ( delete $self->{$text} ) {
29 0           $self->_reset();
30 0           return 1;
31             }
32              
33 0           return 0;
34             }
35              
36             sub get_count {
37 0     0 0   my ($self) = @_;
38              
39 0           return 0 + keys %$self;
40             }
41              
42             #----------------------------------------------------------------------
43              
44             sub _generate_text {
45 0     0     my ($self) = @_;
46              
47 0           return sprintf(
48             '%s UTC: ping #%d (%x)',
49             scalar(gmtime),
50             $self->get_count(),
51             substr(rand, 2),
52             );
53             }
54              
55             sub _reset {
56 0     0     my ($self) = @_;
57              
58 0           return %$self = ();
59             }
60              
61             1;