File Coverage

blib/lib/Test/Statsd.pm
Criterion Covered Total %
statement 78 83 93.9
branch 8 12 66.6
condition 3 7 42.8
subroutine 16 16 100.0
pod 0 6 0.0
total 105 124 84.6


line stmt bran cond sub pod time code
1             package Test::Statsd;
2             {
3             $Test::Statsd::VERSION = '0.19';
4             }
5              
6 12     12   29520 use 5.008;
  12         36  
  12         542  
7 12     12   62 use strict;
  12         18  
  12         380  
8 12     12   54 use warnings;
  12         30  
  12         428  
9              
10 12     12   14898 use AnyEvent;
  12         70692  
  12         476  
11 12     12   7874 use AnyEvent::Strict;
  12         213698  
  12         478  
12 12     12   10092 use AnyEvent::Handle;
  12         240694  
  12         546  
13 12     12   9790 use AnyEvent::Socket;
  12         167188  
  12         1728  
14 12     12   8272 use IO::Socket::INET ();
  12         182292  
  12         414  
15 12     12   7908 use Time::HiRes;
  12         17610  
  12         56  
16              
17             sub new {
18 12     12 0 4272 my ($class, $opt) = @_;
19 12   33     84 $class = ref $class || $class;
20 12   50     38 $opt ||= {};
21 12         58 my $self = {
22             binary => $opt->{binary},
23             config => $opt->{config},
24             _statsd_pid => undef,
25             };
26 12         44 bless $self, $class;
27             }
28              
29             # A read callback (read_cb) can optionally be used in special
30             # cases when you don't want the TCP server to be shut down
31             # when the first flush data is received (see delete-idle-stats test
32             # for an example).
33              
34             sub wait_and_collect_flush_data {
35 6     6 0 505 my ($self, $port, $read_cb) = @_;
36              
37 6         40 $self->{_flush_data} = "";
38              
39             # Pretend to be a carbon/graphite daemon
40 6   50     125 $port ||= 40003;
41              
42 6         11 my $srv;
43 6         450 my $cv = AE::cv;
44              
45             $srv = tcp_server undef, $port, sub {
46 8     8   7497534 my ($fh, $host, $port) = @_;
47 8         28 my $hdl;
48             $hdl = AnyEvent::Handle->new(
49             fh => $fh,
50             on_error => sub {
51 0         0 warn "Socket error: $!\n";
52 0         0 $_[0]->destroy
53             },
54             on_read => sub {
55 8         4992 my ($ae_handle) = @_;
56             # Store graphite data into a private object member
57 8         124 $self->{_flush_data} .= $ae_handle->rbuf;
58 8 100       97 if ($read_cb) {
59 4         31 $read_cb->($hdl, $cv, $self->{_flush_data});
60             # We need to clear the received data now, or our
61             # reader will be surprised receiving the old + new
62             # buffer in the n > 1 round.
63 4         2206 $self->{_flush_data} = "";
64 4         40 $ae_handle->{rbuf} = "";
65             } else {
66             # Calling send() on the condvar stops the TCP server
67 4         55 $cv->send();
68             }
69             },
70 2         274 on_eof => sub { $hdl->destroy },
71 8         267 );
72 6         2206 };
73 6         2378 $cv->recv();
74 6         712 return $self->{_flush_data};
75             }
76              
77             sub hashify {
78 8     8 0 7647 my ($self, $str) = @_;
79 8         151 my @lines = split m{\r?\n}, $str;
80 8         18 my $stats;
81 8         21 for (@lines) {
82 83         441 $_ =~ s{^ \s* (\S*) \s* $}{$1}x;
83 83 50       132 next unless defined;
84 83         169 my ($key, $val, $ts) = split;
85 83         298 $stats->{$key} = $val;
86             }
87 8         34 return $stats;
88             }
89              
90             sub start_statsd {
91 12     12 0 68 my ($self) = @_;
92              
93 12         10206 my $pid = fork;
94 12 50       757 if (! defined $pid) {
    100          
95 0         0 die "Fork failed: $! Aborting.";
96             }
97              
98             # Child
99             elsif ($pid == 0) {
100 6         513 my @binary = split " ", $self->{binary};
101 6         59 my $config = $self->{config};
102 6         0 exec @binary, $config, '2>&1 1>/dev/null';
103             }
104              
105             # Parent
106             else {
107 6         207 $self->{_statsd_pid} = $pid;
108             # Allow for child statsd to start up
109 6         3001239 Time::HiRes::usleep(500_000);
110             }
111             }
112              
113             sub stop_statsd {
114 6     6 0 3227 my ($self) = @_;
115              
116 6         20 my $pid = $self->{_statsd_pid};
117 6 50       25 if (! $pid) {
118 0         0 die "Statsd was never started?";
119             }
120              
121 6 50       168 if (! kill(15, $pid)) {
122 0         0 die "Failed to stop statsd (pid: $pid). "
123             . "Please do something manually ($!)";
124             }
125              
126 6         81 return 1;
127             }
128              
129             sub send_udp {
130 105     105 0 1764 my ($self, $host, $port, $payload) = @_;
131              
132 105         689 my $sock = IO::Socket::INET->new(
133             Proto => 'udp',
134             PeerAddr => $host,
135             PeerPort => $port,
136             );
137              
138 105         41406 my $len = $sock->send($payload);
139 105         6475 $sock->close();
140              
141 105         2670 return $len == length($payload);
142             }
143              
144             1;
145              
146             =pod
147              
148             =head1 NAME
149              
150             Test::Statsd - Test harness for any statsd server daemon
151              
152             =head1 DESCRIPTION
153              
154             Embeds the logic to perform integration tests of any statsd
155             daemon that can be launched from the command line.
156              
157             Usage:
158              
159             my $t = Test::Statsd->new({
160             binary => './bin/statsd',
161             config => './bin/sample-config.json'
162             });
163              
164             # Brings up the statsd server in the background
165             # with the specified configuration, and stores its pid
166             $t->start_statsd();
167              
168            
169             =cut