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

package Net::Statsd::Client::Telegraf;

use strict;
use warnings;
use 5.008_005;
our $VERSION = '0.1';
use Moo;

extends 'Net::Statsd::Client';

has tags => ( is => 'ro', default => sub { {} }, isa => sub { die 'tags is expecting a hashref' unless ref $_[0] and ref $_[0] eq 'HASH'; } );

around increment => sub {
    my ( $orig, $self, $metric, %opt ) = @_;

    return $self->$orig( $self->add_tags($metric, $opt{tags}), $opt{sample_rate});
};

around decrement => sub {
    my ( $orig, $self, $metric, %opt ) = @_;

    return $self->$orig( $self->add_tags($metric, $opt{tags}), $opt{sample_rate});
};

around update => sub {
    my ( $orig, $self, $metric, $count, %opt ) = @_;

    return $self->$orig( $self->add_tags($metric, $opt{tags}), $count, $opt{sample_rate});
};

around timing_ms => sub {
    my ( $orig, $self, $metric, $time, @others ) = @_;

    #ugly layer to handle timer method,
    #Timer method return a timer method which call timing_ms, with the
    #protocal of Net::Statsd::Client, hence, with a scalar after $time
    #use Data::Dumper; warn Dumper( \@others );
    if( scalar( @others ) == 1 ) {
        my $sample_rate = $others[0];

        return $self->$orig( $metric, $time, $sample_rate);
    } else {
        my %opt = @others;
        return $self->$orig( $self->add_tags($metric, $opt{tags}), $time, $opt{sample_rate});
    }
};

around gauge => sub {
    my ( $orig, $self, $metric, $value, %opt ) = @_;

    return $self->$orig( $self->add_tags($metric, $opt{tags}), $value, $opt{sample_rate});
};

around set_add => sub {
    my ( $orig, $self, $metric, $value, %opt ) = @_;

    return $self->$orig( $self->add_tags($metric, $opt{tags}), $value, $opt{sample_rate});
};

around timer => sub {
    my ( $orig, $self, $metric, %opt ) = @_;

    return $self->$orig( $self->add_tags($metric, $opt{tags}), $opt{sample_rate});
};

sub add_tags {
    my ($self, $what, $tags) = @_;

    my $t = '';
    if( defined $tags ) {
        die 'tags is expecting a hashref'
            unless ref $tags and ref $tags eq 'HASH';
        while( my ($name, $value) = each %$tags ) {
            $name =~ s/\s/_/g;
            $value =~ s/\s/_/g;
            $t .= ",$name=$value";
        }
    }
    while( my ($name, $value) = each %{$self->tags} ) {
        $name =~ s/\s/_/g;
        $value =~ s/\s/_/g;
        $t .= ",$name=$value";
    }

    return $what.$t;
}

1;
__END__