File Coverage

blib/lib/Metrics/Any/Adapter/Statsd.pm
Criterion Covered Total %
statement 65 65 100.0
branch 11 18 61.1
condition 5 12 41.6
subroutine 14 14 100.0
pod 0 9 0.0
total 95 118 80.5


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2020-2021 -- leonerd@leonerd.org.uk
5              
6             package Metrics::Any::Adapter::Statsd 0.03;
7              
8 4     4   2120 use v5.14;
  4         15  
9 4     4   23 use warnings;
  4         9  
  4         109  
10              
11 4     4   19 use Carp;
  4         22  
  4         262  
12              
13             # We don't use Net::Statsd because it
14             # a) is hard to override sending for custom formats e.g. SignalFx or DogStatsd
15             # b) sends differently-named stats in different packets, losing atomicity of
16             # distribution updates
17 4     4   646 use IO::Socket::INET;
  4         25279  
  4         36  
18              
19             # TODO: Keep the same config for now
20             $Net::Statsd::HOST //= "127.0.0.1";
21             $Net::Statsd::PORT //= 8125;
22              
23             =head1 NAME
24              
25             C - a metrics reporting adapter for statsd
26              
27             =head1 SYNOPSIS
28              
29             use Metrics::Any::Adapter 'Statsd';
30              
31             =head1 DESCRIPTION
32              
33             This L adapter type reports metrics to statsd via the local UDP
34             socket. Each metric value reported will result in a new UDP packet being sent.
35              
36             The default location of the statsd server is set by two package variables,
37             defaulting to
38              
39             $Net::Statsd::HOST = "127.0.0.1";
40             $Net::Statsd::PORT = 8125
41              
42             The configuration can be changed by setting new values or by passing arguments
43             to the import line:
44              
45             use Metrics::Any::Adapter 'Statsd', port => 8200;
46              
47             =head1 METRIC HANDLING
48              
49             Unlabelled counter, gauge and timing metrics are handled natively as you would
50             expect for statsd; with multipart names being joined by periods (C<.>).
51              
52             Distribution metrics are emitted as two sub-named metrics by appending
53             C and C. The C metric in incremented by one for each
54             observation and the C by the observed amount.
55              
56             Labels are not handled by this adapter and are thrown away. This will result
57             in a single value being reported that accumulates the sum total across all of
58             the label values. In the case of labelled gauges using the C
59             method this will not be a useful value.
60              
61             For better handling of labelled metrics for certain services which have
62             extended the basic statsd format to handle them, see:
63              
64             =over 2
65              
66             =item *
67              
68             L - a metrics reporting adapter for DogStatsd
69              
70             =item *
71              
72             L - a metrics reporting adapter for SignalFx
73              
74             =back
75              
76             =head1 ARGUMENTS
77              
78             The following additional arguments are recognised
79              
80             =head2 host
81              
82             =head2 port
83              
84             Provides specific values for the statsd server location.
85              
86             =cut
87              
88             sub new
89             {
90 3     3 0 49 my $class = shift;
91 3         9 my ( %args ) = @_;
92              
93             return bless {
94             host => $args{host},
95             port => $args{port},
96 3         35 metrics => {},
97             gauge_initialised => {},
98             }, $class;
99             }
100              
101             sub mangle_name
102             {
103 12     12 0 30 my $self = shift;
104 12         20 my ( $name ) = @_;
105              
106 12 50       35 return join ".", @$name if ref $name eq "ARRAY";
107              
108             # Convert _-separated components into .
109 12         31 $name =~ s/_/./g;
110 12         24 return $name;
111             }
112              
113             sub socket
114             {
115 14     14 0 23 my $self = shift;
116              
117             return $self->{socket} //= IO::Socket::INET->new(
118             Proto => "udp",
119             PeerHost => $self->{host} // $Net::Statsd::HOST,
120 14   33     97 PeerPort => $self->{port} // $Net::Statsd::PORT,
      33        
      66        
121             );
122             }
123              
124             sub send
125             {
126 14     14 0 24 my $self = shift;
127 14         30 my ( $stats, $labelnames, $labelvalues ) = @_;
128              
129             $self->socket->send(
130             join "\n", map {
131 14         34 my $name = $_;
  16         1032  
132 16         25 my $value = $stats->{$name};
133 16 100       48 map { sprintf "%s:%s", $name, $_ } ref $value eq "ARRAY" ? @$value : $value
  17         132  
134             } sort keys %$stats
135             );
136             }
137              
138             sub _make
139             {
140 12     12   7393 my $self = shift;
141 12         41 my ( $handle, %args ) = @_;
142              
143 12   33     52 my $name = $self->mangle_name( delete $args{name} // $handle );
144              
145             $self->{metrics}{$handle} = {
146             name => $name,
147             labels => $args{labels},
148 12         102 };
149             }
150              
151             *make_counter = \&_make;
152              
153             sub inc_counter_by
154             {
155 3     3 0 46 my $self = shift;
156 3         9 my ( $handle, $amount, @labelvalues ) = @_;
157              
158 3 50       11 my $meta = $self->{metrics}{$handle} or croak "No metric '$handle'";
159              
160 3         63 my $value = sprintf "%g|c", $amount;
161              
162 3         30 $self->send( { $meta->{name} => $value }, $meta->{labels}, \@labelvalues );
163             }
164              
165             *make_distribution = \&_make;
166              
167             sub report_distribution
168             {
169 2     2 0 80 my $self = shift;
170 2         5 my ( $handle, $amount, @labelvalues ) = @_;
171              
172             # A distribution acts like two counters; `sum` a `count`.
173              
174 2 50       7 my $meta = $self->{metrics}{$handle} or croak "No metric '$handle'";
175              
176 2         18 my $value = sprintf "%g|c", $amount;
177              
178             $self->send( {
179             "$meta->{name}.sum" => $value,
180             "$meta->{name}.count" => "1|c",
181 2         13 }, $meta->{labels}, \@labelvalues );
182             }
183              
184             *inc_distribution_by = \&report_distribution;
185              
186             *make_gauge = \&_make;
187              
188             sub inc_gauge_by
189             {
190 1     1 0 628 my $self = shift;
191 1         2 my ( $handle, $amount, @labelvalues ) = @_;
192              
193 1 50       5 my $meta = $self->{metrics}{$handle} or croak "No metric '$handle'";
194 1         2 my $name = $meta->{name};
195              
196 1         2 my @value;
197 1 50       3 push @value, "0|g" unless $self->{gauge_initialised}{$name};
198 1         9 push @value, sprintf( "%+g|g", $amount );
199              
200 1         5 $self->send( { $name => \@value }, $meta->{labels}, \@labelvalues );
201 1         59 $self->{gauge_initialised}{$name} = 1;
202             }
203              
204             sub set_gauge_to
205             {
206 4     4 0 708 my $self = shift;
207 4         9 my ( $handle, $amount, @labelvalues ) = @_;
208              
209 4 50       15 my $meta = $self->{metrics}{$handle} or croak "No metric '$handle'";
210 4         8 my $name = $meta->{name};
211              
212 4         7 my @value;
213             # wire format interprets a leading - as a decrement request; so negative
214             # absolute values must first set zero
215 4 100       11 push @value, "0|g" if $amount < 0;
216 4         34 push @value, sprintf( "%g|g", $amount );
217              
218 4         21 $self->send( { $name => \@value }, $meta->{labels}, \@labelvalues );
219 4         249 $self->{gauge_initialised}{$name} = 1;
220             }
221              
222             *make_timer = \&_make;
223              
224             sub report_timer
225             {
226 3     3 0 130 my $self = shift;
227 3         7 my ( $handle, $duration, @labelvalues ) = @_;
228              
229 3 50       12 my $meta = $self->{metrics}{$handle} or croak "No metric '$handle'";
230              
231 3         18 my $value = sprintf "%d|ms", $duration * 1000; # msec
232              
233 3         14 $self->send( { $meta->{name} => $value }, $meta->{labels}, \@labelvalues );
234             }
235              
236             *inc_timer_by = \&report_timer;
237              
238             =head1 TODO
239              
240             =over 4
241              
242             =item *
243              
244             Support non-one samplerates; emit only one-in-N packets with the C<@rate>
245             notation in the packet.
246              
247             =item *
248              
249             Optionally support one dimension of labelling by appending the conventional
250             C notation to it.
251              
252             =back
253              
254             =cut
255              
256             =head1 AUTHOR
257              
258             Paul Evans
259              
260             =cut
261              
262             0x55AA;