File Coverage

blib/lib/Net/Statsd/Tiny.pm

Criterion	Covered	Total	%
statement	68	75	90.6
branch	15	24	62.5
condition	4	6	66.6
subroutine	15	16	93.7
pod	4	5	80.0
total	106	126	84.1

package Net::Statsd::Tiny;

# ABSTRACT: A tiny StatsD client that supports multimetric packets

use v5.12;

use warnings;

use parent qw/ Class::Accessor::Fast /;

use Carp ();
use IO::Socket 1.18 ();
use Socket 2.026 ();

our $VERSION = 'v0.4.0';


__PACKAGE__->mk_ro_accessors(
    qw/ host port proto prefix
      autoflush max_buffer_size _socket /
);

sub new {
    my ( $class, @args ) = @_;

    my %args;
    if ( ( @args == 1 ) && ( ref( $args[0] ) eq 'HASH' ) ) {
        %args = %{ $args[0] };
    }
    else {
        %args = @args;
    }

    my %DEFAULTS = (
        host            => '127.0.0.1',
        port            => 8125,
        proto           => 'udp',
        prefix          => '',
        autoflush       => 1,
        max_buffer_size => 512,
    );

    foreach my $attr ( keys %DEFAULTS ) {
        next if exists $args{$attr};
        $args{$attr} = $DEFAULTS{$attr};
    }

    if ( my $socket = delete $args{socket} ) {
        $args{_socket} = $socket;
    }
    else {
        $args{_socket} = IO::Socket::INET->new(
            PeerAddr => $args{host},
            PeerPort => $args{port},
            Proto    => $args{proto},
        ) or die "Failed to initialize socket: $!";
    }

    my $self = $class->SUPER::new( \%args );

    $self->{_buffer} = '';

    return $self;
}


BEGIN {
    my $class = __PACKAGE__;

    my %PROTOCOL = (
        set_add   => 's',
        counter   => 'c',
        gauge     => 'g',
        histogram => 'h',
        meter     => 'm',
        timing    => 'ms',
    );

    foreach my $name ( keys %PROTOCOL ) {

        no strict 'refs';    ## no critic (ProhibitNoStrict)

        my $suffix = '|' . $PROTOCOL{$name};

        *{"${class}::${name}"} = sub {
            my ( $self, $metric, $value, $rate ) = @_;
            if ( ( defined $rate ) && ( $rate < 1 ) ) {
                $self->_record( $suffix . '|@' . $rate, $metric, $value )
                    if rand() < $rate;
            }
            else {
                $self->_record( $suffix, $metric, $value );
            }
        };

    }

    # Alises for other Net::Statsd::Client or Etsy::StatsD

    {
        no strict 'refs';    ## no critic (ProhibitNoStrict)

        *{"${class}::update"}    = \&counter;
        *{"${class}::timing_ms"} = \&timing;

    }

}

sub increment {
    my ( $self, $metric, $rate ) = @_;
    $self->counter( $metric, 1, $rate );
}

sub decrement {
    my ( $self, $metric, $rate ) = @_;
    $self->counter( $metric, -1, $rate );
}

sub _record {
    my ( $self, $suffix, $metric, $value ) = @_;

    Carp::croak "malformed metric" if $metric =~ /[\N{U+00}-\N{U+1f}:|]/;
    Carp::croak "malformed value"  if $value  =~ /[\N{U+00}-\N{U+1f}:|]/;

    my $data = $self->prefix . $metric . ':' . $value . $suffix . "\n";

    if ( $self->autoflush ) {
        $self->_socket->send( $data, 0 );
        return;
    }

    my $avail = $self->max_buffer_size - length( $self->{_buffer} );
    $self->flush if length($data) > $avail;

    $self->{_buffer} .= $data;
}



sub flush {
    my ($self) = @_;

    if ( length($self->{_buffer}) ) {
        send( $self->_socket, $self->{_buffer}, 0 );
        $self->{_buffer} = '';
    }
}

sub DEMOLISH {
    my ( $self, $is_global ) = @_;

    return if $is_global;

    $self->flush;
}


1;

__END__