File Coverage

blib/lib/Metrics/Any/Adapter/SignalFx.pm
Criterion Covered Total %
statement 27 28 96.4
branch 1 2 50.0
condition n/a
subroutine 5 5 100.0
pod 0 1 0.0
total 33 36 91.6


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-2026 -- leonerd@leonerd.org.uk
5              
6             package Metrics::Any::Adapter::SignalFx 0.04;
7              
8 2     2   321653 use v5.14;
  2         6  
9 2     2   25 use warnings;
  2         3  
  2         105  
10 2     2   9 use base qw( Metrics::Any::Adapter::Statsd );
  2         5  
  2         862  
11              
12             # See also
13             # https://docs.signalfx.com/en/latest/integrations/agent/monitors/collectd-statsd.html
14              
15             =head1 NAME
16              
17             C - a metrics reporting adapter for SignalFx
18              
19             =head1 SYNOPSIS
20              
21             =for highlighter language=perl
22              
23             use Metrics::Any::Adapter 'SignalFx';
24              
25             =head1 DESCRIPTION
26              
27             This extension of L supports the additional tag
28             reporting syntax defined by F to report labelled metrics. Due to
29             limitations of the line-based protocol, certain characters are not allowed in
30             label names or values. Any C<[>, C<]>, C<,>, C<|>, C<=> or linefeeds are
31             replaced by C<_>.
32              
33             =cut
34              
35             sub _labels
36             {
37 6     6   8 my ( $labelnames, $labelvalues ) = @_;
38              
39 6         7 my @labels;
40 6         10 foreach ( 0 .. $#$labelnames ) {
41 6         8 my $name = $labelnames->[$_];
42 6         27 my $value = $labelvalues->[$_];
43             # Replace disallowed characters with '_'
44 6         19 $_ =~ s/[][,|=\n]/_/g for $name, $value;
45              
46 6         13 push @labels, "$name=$value";
47             }
48              
49 6         46 return "[" . join( ",", @labels ) . "]";
50             }
51              
52             sub send
53             {
54 5     5 0 6 my $self = shift;
55 5         7 my ( $stats, $labelnames, $labelvalues ) = @_;
56              
57 5         6 my %labelledstats;
58 5 50       8 if( $labelnames ) {
59 5         10 foreach my $name ( keys %$stats ) {
60 6         10 my $value = $stats->{$name};
61 6         13 my @parts = split m/\./, $name;
62 6         9 $parts[-1] = _labels( $labelnames, $labelvalues ) . $parts[-1];
63 6         13 $name = join ".", @parts;
64              
65 6         16 $labelledstats{$name} = $value;
66             }
67             }
68             else {
69 0         0 %labelledstats = %$stats;
70             }
71              
72 5         16 $self->SUPER::send( \%labelledstats );
73             }
74              
75             =head1 AUTHOR
76              
77             Paul Evans
78              
79             =cut
80              
81             0x55AA;