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.06';

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 {
	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;
	}

	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__