File Coverage

blib/lib/DataDog/DogStatsd.pm
Criterion Covered Total %
statement 98 100 98.0
branch 16 20 80.0
condition 22 32 68.7
subroutine 17 17 100.0
pod 10 13 76.9
total 163 182 89.5


line stmt bran cond sub pod time code
1             package DataDog::DogStatsd;
2              
3             # ABSTRACT: A Perl client for DogStatsd
4              
5 4     4   159374 use strict;
  4         19  
  4         115  
6 4     4   22 use warnings;
  4         9  
  4         163  
7              
8             our $VERSION = '0.05';
9              
10 4     4   1092 use IO::Socket::INET;
  4         42775  
  4         36  
11              
12             my %OPTS_KEYS = (
13             date_happened => 'd',
14             hostname => 'h',
15             aggregation_key => 'k',
16             priority => 'p',
17             source_type_name => 's',
18             alert_type => 't'
19             );
20              
21             sub new {
22 4     4 1 1398 my $classname = shift;
23 4   33     35 my $class = ref( $classname ) || $classname;
24 4 50       29 my %p = @_ % 2 ? %{$_[0]} : @_;
  0         0  
25              
26 4   50     33 $p{host} ||= '127.0.0.1';
27 4   100     20 $p{port} ||= 8125;
28 4   50     50 $p{namespace} ||= '';
29              
30 4         23 return bless \%p, $class;
31             }
32              
33             sub _socket {
34 46     46   76 my $self = shift;
35 46 100       1037 return $self->{_socket} if $self->{_socket};
36             $self->{_socket} = IO::Socket::INET->new(
37             PeerAddr => $self->{'host'},
38 4         40 PeerPort => $self->{'port'},
39             Proto => 'udp'
40             );
41 4         2005 return $self->{_socket};
42             }
43              
44             sub namespace {
45 2     2 1 2329 my $self = shift;
46 2         8 $self->{'namespace'} = shift;
47             }
48              
49             sub increment {
50 11     11 1 1618 my $self = shift;
51 11         21 my $stat = shift;
52 11   100     45 my $opts = shift || {};
53 11         69 $self->count( $stat, 1, $opts );
54             }
55              
56             sub decrement {
57 9     9 1 3076 my $self = shift;
58 9         20 my $stat = shift;
59 9   100     41 my $opts = shift || {};
60 9         40 $self->count( $stat, -1, $opts );
61             }
62              
63             sub count {
64 20     20 1 39 my $self = shift;
65 20         32 my $stat = shift;
66 20         27 my $count = shift;
67 20   50     49 my $opts = shift || {};
68 20         54 $self->send_stats( $stat, $count, 'c', $opts );
69             }
70              
71             sub gauge {
72 9     9 1 2758 my $self = shift;
73 9         17 my $stat = shift;
74 9         17 my $value = shift;
75 9   100     41 my $opts = shift || {};
76 9         56 $self->send_stats( $stat, $value, 'g', $opts );
77             }
78              
79             sub histogram {
80 2     2 1 13 my $self = shift;
81 2         6 my $stat = shift;
82 2         5 my $value = shift;
83 2   50     16 my $opts = shift || {};
84 2         9 $self->send_stats( $stat, $value, 'h', $opts );
85             }
86              
87             sub timing {
88 10     10 1 2701 my $self = shift;
89 10         20 my $stat = shift;
90 10         18 my $ms = shift;
91 10   100     39 my $opts = shift || {};
92 10         90 $self->send_stats( $stat, sprintf("%d", $ms), 'ms', $opts );
93             }
94              
95             # Reports execution time of the provided block using {#timing}.
96             #
97             # @param [String] stat stat name
98             # @param [Hash] opts the options to create the metric with
99             # @option opts [Numeric] :sample_rate sample rate, 1 for always
100             # @option opts [Array] :tags An array of tags
101             # @yield The operation to be timed
102             # @see #timing
103             # @example Report the time (in ms) taken to activate an account
104             # $statsd.time('account.activate') { @account.activate! }
105             ##def time(stat, opts={})
106             ## start = Time.now
107             ## result = yield
108             ## timing(stat, ((Time.now - start) * 1000).round, opts)
109             ## result
110             ##end
111              
112             sub set {
113 1     1 1 10 my $self = shift;
114 1         4 my $stat = shift;
115 1         12 my $value = shift;
116 1   50     9 my $opts = shift || {};
117 1         6 $self->send_stats( $stat, $value, 's', $opts );
118             }
119              
120             sub event {
121 4     4 1 2656 my $self = shift;
122 4         9 my $title = shift;
123 4         8 my $text = shift;
124 4   100     18 my $opts = shift || {};
125              
126 4         12 my $event_string = format_event( $title, $text, $opts );
127              
128 4         11 $self->send_to_socket($event_string);
129             }
130              
131             sub format_event {
132 4     4 0 7 my $title = shift;
133 4         7 my $text = shift;
134 4   50     20 my $opts = shift || {};
135              
136 4         9 my $tags = delete $opts->{tags};
137              
138 4         13 $title =~ s/\n/\\n/g;
139 4         8 $text =~ s/\n/\\n/g;
140              
141 4         20 my $event_string_data = sprintf "_e{%d,%d}:%s|%s",
142             length($title), length($text), $title, $text;
143              
144 4         14 for my $opt ( keys %$opts ) {
145 1 50       5 if ( my $key = $OPTS_KEYS{$opt} ) {
146 1         6 $opts->{$opt} =~ s/|//g;
147 1         5 $event_string_data .= "|$key:$opts->{$opt}";
148             }
149             }
150              
151 4 100       14 if ($tags) {
152 2         6 $event_string_data .= "|#" . join ",", map { s/|//g; $_ } @$tags;
  4         16  
  4         11  
153             }
154              
155 4         10 return $event_string_data;
156             }
157              
158             sub send_stats {
159 42     42 0 80 my $self = shift;
160 42         66 my $stat = shift;
161 42         61 my $delta = shift;
162 42         62 my $type = shift;
163 42   50     90 my $opts = shift || {};
164              
165 42 100       111 my $sample_rate = defined $opts->{'sample_rate'} ? $opts->{'sample_rate'} : 1;
166 42 50 66     156 if( $sample_rate == 1 || rand() <= $sample_rate ) {
167 42         113 $stat =~ s/::/./g;
168 42         107 $stat =~ s/[:|@]/_/g;
169 42         81 my $rate = '';
170 42 100       96 $rate = "|\@${sample_rate}" unless $sample_rate == 1;
171 42         60 my $tags = '';
172 42 100       104 $tags = "|#".join(',',@{$opts->{'tags'}}) if $opts->{'tags'};
  13         43  
173 42         144 my $message = $self->{'namespace'}."${stat}:${delta}|${type}${rate}${tags}";
174 42         97 return $self->send_to_socket( $message );
175             }
176             }
177              
178             sub send_to_socket {
179 46     46 0 101 my ($self, $message) = @_;
180              
181 46         134 my $r = send($self->_socket(), $message, 0);
182 46 100       250 if (! defined $r) {
    50          
183 7         40 return 0;
184             } elsif ($r != length($message)) {
185 0         0 return 0;
186             }
187              
188 39         192 return 1;
189             }
190              
191             1;
192             __END__