File Coverage

blib/lib/Net/Statsd/Client/Telegraf.pm
Criterion Covered Total %
statement 25 25 100.0
branch 3 4 75.0
condition 1 3 33.3
subroutine 5 5 100.0
pod 0 1 0.0
total 34 38 89.4


line stmt bran cond sub pod time code
1             package Net::Statsd::Client::Telegraf;
2              
3 1     1   774 use strict;
  1         2  
  1         27  
4 1     1   4 use warnings;
  1         1  
  1         22  
5 1     1   17 use 5.008_005;
  1         4  
6             our $VERSION = '0.1';
7 1     1   519 use Moo;
  1         10119  
  1         5  
8              
9             extends 'Net::Statsd::Client';
10              
11             has tags => ( is => 'ro', default => sub { {} }, isa => sub { die 'tags is expecting a hashref' unless ref $_[0] and ref $_[0] eq 'HASH'; } );
12              
13             around increment => sub {
14             my ( $orig, $self, $metric, %opt ) = @_;
15              
16             return $self->$orig( $self->add_tags($metric, $opt{tags}), $opt{sample_rate});
17             };
18              
19             around decrement => sub {
20             my ( $orig, $self, $metric, %opt ) = @_;
21              
22             return $self->$orig( $self->add_tags($metric, $opt{tags}), $opt{sample_rate});
23             };
24              
25             around update => sub {
26             my ( $orig, $self, $metric, $count, %opt ) = @_;
27              
28             return $self->$orig( $self->add_tags($metric, $opt{tags}), $count, $opt{sample_rate});
29             };
30              
31             around timing_ms => sub {
32             my ( $orig, $self, $metric, $time, @others ) = @_;
33              
34             #ugly layer to handle timer method,
35             #Timer method return a timer method which call timing_ms, with the
36             #protocal of Net::Statsd::Client, hence, with a scalar after $time
37             #use Data::Dumper; warn Dumper( \@others );
38             if( scalar( @others ) == 1 ) {
39             my $sample_rate = $others[0];
40              
41             return $self->$orig( $metric, $time, $sample_rate);
42             } else {
43             my %opt = @others;
44             return $self->$orig( $self->add_tags($metric, $opt{tags}), $time, $opt{sample_rate});
45             }
46             };
47              
48             around gauge => sub {
49             my ( $orig, $self, $metric, $value, %opt ) = @_;
50              
51             return $self->$orig( $self->add_tags($metric, $opt{tags}), $value, $opt{sample_rate});
52             };
53              
54             around set_add => sub {
55             my ( $orig, $self, $metric, $value, %opt ) = @_;
56              
57             return $self->$orig( $self->add_tags($metric, $opt{tags}), $value, $opt{sample_rate});
58             };
59              
60             around timer => sub {
61             my ( $orig, $self, $metric, %opt ) = @_;
62              
63             return $self->$orig( $self->add_tags($metric, $opt{tags}), $opt{sample_rate});
64             };
65              
66             sub add_tags {
67 15     15 0 36 my ($self, $what, $tags) = @_;
68              
69 15         26 my $t = '';
70 15 100       35 if( defined $tags ) {
71 5 50 33     26 die 'tags is expecting a hashref'
72             unless ref $tags and ref $tags eq 'HASH';
73 5         20 while( my ($name, $value) = each %$tags ) {
74 5         13 $name =~ s/\s/_/g;
75 5         8 $value =~ s/\s/_/g;
76 5         18 $t .= ",$name=$value";
77             }
78             }
79 15         18 while( my ($name, $value) = each %{$self->tags} ) {
  20         68  
80 5         9 $name =~ s/\s/_/g;
81 5         11 $value =~ s/\s/_/g;
82 5         12 $t .= ",$name=$value";
83             }
84              
85 15         87 return $what.$t;
86             }
87              
88             1;
89             __END__