File Coverage

blib/lib/Net/Statsd.pm
Criterion Covered Total %
statement 70 83 84.3
branch 25 36 69.4
condition 7 11 63.6
subroutine 10 11 90.9
pod 6 6 100.0
total 118 147 80.2


line stmt bran cond sub pod time code
1             package Net::Statsd;
2             {
3             $Net::Statsd::VERSION = '0.11';
4             }
5              
6             # ABSTRACT: Sends statistics to the stats daemon over UDP
7             # Cosimo Streppone
8              
9 4     4   54720 use strict;
  4         6  
  4         132  
10 4     4   19 use warnings;
  4         5  
  4         97  
11 4     4   14 use Carp ();
  4         7  
  4         43  
12 4     4   1882 use IO::Socket ();
  4         62896  
  4         2504  
13              
14             our $HOST = 'localhost';
15             our $PORT = 8125;
16              
17             my $SOCK;
18             my $SOCK_PEER;
19              
20              
21              
22             sub timing {
23 1     1 1 446 my ($name, $time, $sample_rate) = @_;
24              
25 1 50       3 if (! defined $sample_rate) {
26 1         1 $sample_rate = 1;
27             }
28              
29 1         5 my $stats = {
30             $name => sprintf "%d|ms", $time
31             };
32              
33 1         3 return Net::Statsd::send($stats, $sample_rate);
34             }
35              
36              
37             sub increment {
38 10004     10004 1 292171 my ($stats, $sample_rate) = @_;
39              
40 10004         9274 return Net::Statsd::update_stats($stats, 1, $sample_rate);
41             }
42              
43             *inc = *increment;
44              
45              
46             sub decrement {
47 0     0 1 0 my ($stats, $sample_rate) = @_;
48              
49 0         0 return Net::Statsd::update_stats($stats, -1, $sample_rate);
50             }
51              
52             *dec = *decrement;
53              
54              
55             sub update_stats {
56 10004     10004 1 6815 my ($stats, $delta, $sample_rate) = @_;
57              
58 10004 50       11710 if (! defined $delta) {
59 0         0 $delta = 1;
60             }
61              
62 10004 100       10368 if (! defined $sample_rate) {
63 3         4 $sample_rate = 1;
64             }
65              
66 10004 100       9650 if (! ref $stats) {
    50          
67 10003         10621 $stats = [ $stats ];
68             }
69             elsif (ref $stats eq 'HASH') {
70 0         0 Carp::croak("Usage: update_stats(\$str, ...) or update_stats(\\\@list, ...)");
71             }
72              
73 10004         6500 my %data = map { $_ => sprintf "%s|c", $delta } @{ $stats };
  10005         25553  
  10004         9456  
74              
75 10004         11945 return Net::Statsd::send(\%data, $sample_rate)
76             }
77              
78              
79             sub gauge {
80 3     3 1 3880 my $stats = {};
81              
82 3         12 while (my($name, $value) = splice(@_, 0, 2)) {
83 6 50       10 $value = 0 unless defined $value;
84             # Didn't use '%d' because values might be floats
85 6         4 push @{ $stats->{$name} }, sprintf("%s|g", $value);
  6         32  
86             }
87              
88 3         4 return Net::Statsd::send($stats, 1);
89             }
90              
91              
92             sub send {
93 10008     10008 1 7423 my ($data, $sample_rate) = @_;
94              
95 10008         8548 my $sampled_data = _sample_data($data, $sample_rate);
96              
97             # No sampled_data can happen when:
98             # 1) No $data came in
99             # 2) Sample rate was low enough that we don't want to send events
100 10008 100       12214 if (! $sampled_data) {
101 5036         6946 return;
102             }
103              
104             # Cache the socket to avoid dns and socket creation overheads
105             # (this boosts performance from ~6k to >60k sends/sec)
106 4972 100 66     21147 if (!$SOCK || !$SOCK_PEER || "$HOST:$PORT" ne $SOCK_PEER) {
      66        
107              
108             $SOCK = IO::Socket::INET->new(
109             Proto => 'udp',
110             PeerAddr => $HOST,
111             PeerPort => $PORT,
112 2 50       17 ) or do {
113 0 0       0 Carp::carp("Net::Statsd can't create a socket to $HOST:$PORT: $!")
114             unless our $_warn_once->{"$HOST:$PORT"}++;
115             return
116 0         0 };
117 2         1316 $SOCK_PEER = "$HOST:$PORT";
118              
119             # We don't want to die if Net::Statsd::send() doesn't work...
120             # We could though:
121             #
122             # or die "Could not create UDP socket: $!\n";
123             }
124              
125 4972         3334 my $all_sent = 1;
126              
127 4972         3027 keys %{ $sampled_data }; # reset iterator
  4972         4827  
128 4972         3242 while (my ($stat, $value) = each %{ $sampled_data }) {
  9947         16396  
129 4975         2707 my $packet;
130 4975 100       5201 if (ref $value eq 'ARRAY') {
131             # https://github.com/etsy/statsd/blob/master/docs/metric_types.md#multi-metric-packets
132 5         4 $packet = join("\n", map { "$stat:$_" } @{ $value });
  6         13  
  5         5  
133             }
134             else {
135             # Single value as scalar
136 4970         4815 $packet = "$stat:$value";
137             }
138             # send() returns the number of characters sent, or undef on error.
139 4975         42174 my $r = CORE::send($SOCK, $packet, 0);
140 4975 50       13516 if (!defined $r) {
    50          
141             #warn "Net::Statsd send error: $!";
142 0         0 $all_sent = 0;
143             }
144             elsif ($r != length($packet)) {
145             #warn "Net::Statsd send truncated: $!";
146 0         0 $all_sent = 0;
147             }
148             }
149              
150 4972         11257 return $all_sent;
151             }
152              
153              
154             sub _sample_data {
155 20010     20010   29249 my ($data, $sample_rate) = @_;
156              
157 20010 50 33     53612 if (! $data || ref $data ne 'HASH') {
158 0         0 Carp::croak("No data?");
159             }
160              
161 20010 100       21614 if (! defined $sample_rate) {
162 1         1 $sample_rate = 1;
163             }
164              
165             # Sample rate > 1 doesn't make sense though
166 20010 100       23115 if ($sample_rate >= 1) {
167 9         16 return $data;
168             }
169              
170 20001         10680 my $sampled_data;
171              
172             # Perform sampling here, so that clients using Net::Statsd
173             # don't have to do it every time. This is the same
174             # implementation criteria used in the other statsd client libs
175             #
176             # If rand() doesn't trigger, then no data will be sent
177             # to the statsd server, which is what we want.
178              
179 20001 100       24334 if (rand() <= $sample_rate) {
180 9983         5630 while (my ($stat, $value) = each %{ $data }) {
  24984         40621  
181             # Uglier, but if there's no data to be sampled,
182             # we get a clean undef as returned value
183 15001   100     24626 $sampled_data ||= {};
184              
185             # Multi-metric packet:
186             # https://github.com/etsy/statsd/blob/master/docs/metric_types.md#multi-metric-packets
187 15001 50       14292 if (ref $value eq 'ARRAY') {
188 0         0 foreach my $v ( @{ $value } ) {
  0         0  
189 0         0 push @{ $sampled_data->{$stat} }, sprintf("%s|@%s", $v, $sample_rate);
  0         0  
190             }
191             }
192             # Single value as scalar
193             else {
194 15001         48267 $sampled_data->{$stat} = sprintf "%s|@%s", $value, $sample_rate;
195             }
196             }
197             }
198              
199 20001         18304 return $sampled_data;
200             }
201              
202             1;
203              
204             __END__