File Coverage

blib/lib/DataDog/DogStatsd.pm

Criterion	Covered	Total	%
statement	99	101	98.0
branch	17	22	77.2
condition	23	32	71.8
subroutine	17	17	100.0
pod	10	13	76.9
total	166	185	89.7

package DataDog::DogStatsd;

# ABSTRACT: A Perl client for DogStatsd

use strict;
use warnings;

our $VERSION = '0.07';

use IO::Socket::INET;

my %OPTS_KEYS = (
    date_happened    => 'd',
    hostname         => 'h',
    aggregation_key  => 'k',
    priority         => 'p',
    source_type_name => 's',
    alert_type       => 't'
);

sub new {    ## no critic (Subroutines::RequireArgUnpacking)
    my $classname = shift;
    my $class     = ref($classname) || $classname;
    my %p         = @_ % 2 ? %{$_[0]} : @_;

    $p{host}      ||= '127.0.0.1';
    $p{port}      ||= 8125;
    $p{namespace} ||= '';

    return bless \%p, $class;
}

sub _socket {
    my $self = shift;
    return $self->{_socket} if $self->{_socket};
    $self->{_socket} = IO::Socket::INET->new(
        PeerAddr => $self->{'host'},
        PeerPort => $self->{'port'},
        Proto    => 'udp'
    );
    return $self->{_socket};
}

sub namespace {
    my $self = shift;
    return $self->{'namespace'} unless @_;
    $self->{'namespace'} = shift;
}

sub increment {
    my $self = shift;
    my $stat = shift;
    my $opts = shift || {};
    $self->count($stat, 1, $opts);
}

sub decrement {
    my $self = shift;
    my $stat = shift;
    my $opts = shift || {};
    $self->count($stat, -1, $opts);
}

sub count {
    my $self  = shift;
    my $stat  = shift;
    my $count = shift;
    my $opts  = shift || {};
    $self->send_stats($stat, $count, 'c', $opts);
}

sub gauge {
    my $self  = shift;
    my $stat  = shift;
    my $value = shift;
    my $opts  = shift || {};
    $self->send_stats($stat, $value, 'g', $opts);
}

sub histogram {
    my $self  = shift;
    my $stat  = shift;
    my $value = shift;
    my $opts  = shift || {};
    $self->send_stats($stat, $value, 'h', $opts);
}

sub timing {
    my $self = shift;
    my $stat = shift;
    my $ms   = shift;
    my $opts = shift || {};
    $self->send_stats($stat, sprintf("%d", $ms), 'ms', $opts);
}

# Reports execution time of the provided block using {#timing}.
#
# @param [String] stat stat name
# @param [Hash] opts the options to create the metric with
# @option opts [Numeric] :sample_rate sample rate, 1 for always
# @option opts [Array] :tags An array of tags
# @yield The operation to be timed
# @see #timing
# @example Report the time (in ms) taken to activate an account
#   $statsd.time('account.activate') { @account.activate! }
##def time(stat, opts={})
##	start = Time.now
##	result = yield
##	timing(stat, ((Time.now - start) * 1000).round, opts)
##	result
##end

sub set {
    my $self  = shift;
    my $stat  = shift;
    my $value = shift;
    my $opts  = shift || {};
    $self->send_stats($stat, $value, 's', $opts);
}

sub event {
    my $self  = shift;
    my $title = shift;
    my $text  = shift;
    my $opts  = shift || {};

    my $event_string = format_event($title, $text, $opts);

    $self->send_to_socket($event_string);
}

sub format_event {
    my $title = shift;
    my $text  = shift;
    my $opts  = shift || {};

    my $tags = delete $opts->{tags};

    $title =~ s/\n/\\n/g;
    $text  =~ s/\n/\\n/g;

    my $event_string_data = sprintf "_e{%d,%d}:%s|%s", length($title), length($text), $title, $text;

    for my $opt (keys %$opts) {
        if (my $key = $OPTS_KEYS{$opt}) {
            $opts->{$opt} =~ s/|//g;
            $event_string_data .= "|$key:$opts->{$opt}";
        }
    }

    if ($tags) {
        $event_string_data .= "|#" . join ",", map { s/|//g; $_ } @$tags;    ## no critic (ControlStructures::ProhibitMutatingListFunctions)
    }

    return $event_string_data;
}

sub send_stats {
    my $self  = shift;
    my $stat  = shift;
    my $delta = shift;
    my $type  = shift;
    my $opts  = shift || {};

    my $sample_rate = defined $opts->{'sample_rate'} ? $opts->{'sample_rate'} : 1;
    if ($sample_rate == 1 || rand() <= $sample_rate) {
        $stat =~ s/::/./g;
        $stat =~ s/[:|@]/_/g;
        my $rate = '';
        $rate = "|\@${sample_rate}" unless $sample_rate == 1;
        my $tags = '';
        $tags = "|#" . join(',', @{$opts->{'tags'}}) if $opts->{'tags'};
        my $message = $self->{'namespace'} . "${stat}:${delta}|${type}${rate}${tags}";
        return $self->send_to_socket($message);
    }
}

sub send_to_socket {
    my ($self, $message) = @_;

    my $r = send($self->_socket(), $message, 0);
    if (!defined $r) {
        return 0;
    } elsif ($r != length($message)) {
        return 0;
    }

    return 1;
}

1;
__END__