File Coverage

blib/lib/Net/Statsd.pm

Criterion	Covered	Total	%
statement	70	83	84.3
branch	25	36	69.4
condition	7	11	63.6
subroutine	10	11	90.9
pod	6	6	100.0
total	118	147	80.2

package Net::Statsd;
{
  $Net::Statsd::VERSION = '0.12';
}

# ABSTRACT: Perl client for Etsy's statsd daemon

use strict;
use warnings;
use Carp ();
use IO::Socket ();

our $HOST = 'localhost';
our $PORT = 8125;

my $SOCK;
my $SOCK_PEER;



sub timing {
    my ($name, $time, $sample_rate) = @_;

    if (! defined $sample_rate) {
        $sample_rate = 1;
    }

    my $stats = {
        $name => sprintf "%d|ms", $time
    };

    return Net::Statsd::send($stats, $sample_rate);
}


sub increment {
    my ($stats, $sample_rate) = @_;

    return Net::Statsd::update_stats($stats, 1, $sample_rate);
}

*inc = *increment;


sub decrement {
    my ($stats, $sample_rate) = @_;

    return Net::Statsd::update_stats($stats, -1, $sample_rate);
}

*dec = *decrement;


sub update_stats {
    my ($stats, $delta, $sample_rate) = @_;

    if (! defined $delta) {
        $delta = 1;
    }

    if (! defined $sample_rate) {
        $sample_rate = 1;
    }

    if (! ref $stats) {
        $stats = [ $stats ];
    }
    elsif (ref $stats eq 'HASH') {
        Carp::croak("Usage: update_stats(\$str, ...) or update_stats(\\\@list, ...)");
    }

    my %data = map { $_ => sprintf "%s|c", $delta } @{ $stats };

    return Net::Statsd::send(\%data, $sample_rate)
}


sub gauge {
    my $stats = {};

    while (my($name, $value) = splice(@_, 0, 2)) {
        $value = 0 unless defined $value;
        # Didn't use '%d' because values might be floats
        push @{ $stats->{$name} }, sprintf("%s|g", $value);
    }

    return Net::Statsd::send($stats, 1);
}


sub send {
    my ($data, $sample_rate) = @_;

    my $sampled_data = _sample_data($data, $sample_rate);

    # No sampled_data can happen when:
    # 1) No $data came in
    # 2) Sample rate was low enough that we don't want to send events
    if (! $sampled_data) {
        return;
    }

    # Cache the socket to avoid dns and socket creation overheads
    # (this boosts performance from ~6k to >60k sends/sec)
    if (!$SOCK || !$SOCK_PEER || "$HOST:$PORT" ne $SOCK_PEER) {

        $SOCK = IO::Socket::INET->new(
            Proto    => 'udp',
            PeerAddr => $HOST,
            PeerPort => $PORT,
        ) or do {
            Carp::carp("Net::Statsd can't create a socket to $HOST:$PORT: $!")
                unless our $_warn_once->{"$HOST:$PORT"}++;
            return
        };
        $SOCK_PEER = "$HOST:$PORT";

        # We don't want to die if Net::Statsd::send() doesn't work...
        # We could though:
        #
        # or die "Could not create UDP socket: $!\n";
    }

    my $all_sent = 1;

    keys %{ $sampled_data }; # reset iterator
    while (my ($stat, $value) = each %{ $sampled_data }) {
        my $packet;
        if (ref $value eq 'ARRAY') {
            # https://github.com/etsy/statsd/blob/master/docs/metric_types.md#multi-metric-packets
            $packet = join("\n", map { "$stat:$_" } @{ $value });
        }
        else {
            # Single value as scalar
            $packet = "$stat:$value";
        }
        # send() returns the number of characters sent, or undef on error.
        my $r = CORE::send($SOCK, $packet, 0);
        if (!defined $r) {
            #warn "Net::Statsd send error: $!";
            $all_sent = 0;
        }
        elsif ($r != length($packet)) {
            #warn "Net::Statsd send truncated: $!";
            $all_sent = 0;
        }
    }

    return $all_sent;
}


sub _sample_data {
    my ($data, $sample_rate) = @_;

    if (! $data || ref $data ne 'HASH') {
        Carp::croak("No data?");
    }

    if (! defined $sample_rate) {
        $sample_rate = 1;
    }

    # Sample rate > 1 doesn't make sense though
    if ($sample_rate >= 1) {
        return $data;
    }

    my $sampled_data;

    # Perform sampling here, so that clients using Net::Statsd
    # don't have to do it every time. This is the same
    # implementation criteria used in the other statsd client libs
    #
    # If rand() doesn't trigger, then no data will be sent
    # to the statsd server, which is what we want.

    if (rand() <= $sample_rate) {
        while (my ($stat, $value) = each %{ $data }) {
            # Uglier, but if there's no data to be sampled,
            # we get a clean undef as returned value
            $sampled_data ||= {};

            # Multi-metric packet:
            # https://github.com/etsy/statsd/blob/master/docs/metric_types.md#multi-metric-packets
            if (ref $value eq 'ARRAY') {
                foreach my $v ( @{ $value } ) {
                    push @{ $sampled_data->{$stat} }, sprintf("%s|@%s", $v, $sample_rate);
                }
            }
            # Single value as scalar
            else {
                $sampled_data->{$stat} = sprintf "%s|@%s", $value, $sample_rate;
            }
        }
    }

    return $sampled_data;
}

1;

__END__