File Coverage

lib/Net/Statsite/Client.pm
Criterion Covered Total %
statement 34 60 56.6
branch 9 22 40.9
condition 0 3 0.0
subroutine 10 14 71.4
pod 7 7 100.0
total 60 106 56.6


line stmt bran cond sub pod time code
1             package Net::Statsite::Client;
2 1     1   834 use 5.008001;
  1         2  
3 1     1   3 use strict;
  1         1  
  1         19  
4 1     1   26 use warnings;
  1         2  
  1         79  
5              
6             our $VERSION = '1.0.2';
7              
8 1     1   580 use IO::Socket;
  1         15619  
  1         3  
9 1     1   370 use Carp;
  1         1  
  1         592  
10              
11             =head1 NAME
12              
13             Net::Statsite::Client - Object-Oriented Client for L server
14              
15             =head1 SYNOPSIS
16              
17             use Net::Statsite::Client;
18             my $statsite = Net::Statsite::Client->new(
19             host => 'localhost',
20             prefix => 'test',
21             );
22              
23             $statsite->increment('item'); #increment key test.item
24              
25             =head1 DESCRIPTION
26              
27             Net::Statsite::Client is based on L but with new - C interface and C method.
28              
29              
30             =head1 METHODS
31              
32             =head2 new (host => $host, port => $port, sample_rate => $sample_rate, prefix => $prefix)
33              
34             Create a new instance.
35              
36             I - hostname of statsite server (default: localhost)
37              
38             I - port of statsite server (port: 8125)
39              
40             I - rate of sends metrics (default: 1)
41              
42             I - prefix metric name (default: '')
43              
44             =cut
45              
46             sub new {
47 2     2 1 1956 my ($class, %options) = @_;
48 2 50       9 $options{host} = 'localhost' unless defined $options{host};
49 2 100       4 $options{port} = 8125 unless defined $options{port};
50 2 50       8 $options{prefix} = '' unless defined $options{prefix};
51              
52             my $sock = new IO::Socket::INET(
53             PeerAddr => $options{host},
54             PeerPort => $options{port},
55 2 50       12 Proto => 'udp',
56             ) or croak "Failed to initialize socket: $!";
57              
58 2         1095 bless { socket => $sock, sample_rate => $options{sample_rate}, prefix => $options{prefix} }, $class;
59             }
60              
61             =head2 timing(STAT, TIME, SAMPLE_RATE)
62              
63             Log timing information (should be in miliseconds)
64              
65             =cut
66              
67             sub timing {
68 1     1 1 442 my ($self, $stat, $time, $sample_rate) = @_;
69 1         6 $self->send({ $stat => "$time|ms" }, $sample_rate);
70             }
71              
72             =head2 increment(STATS, SAMPLE_RATE)
73              
74             Increment one of more stats counters.
75              
76             =cut
77              
78             sub increment {
79 1     1 1 667 my ($self, $stats, $sample_rate) = @_;
80 1         3 $self->update($stats, 1, $sample_rate);
81             }
82              
83             =head2 decrement(STATS, SAMPLE_RATE)
84              
85             Decrement one of more stats counters.
86              
87             =cut
88              
89             sub decrement {
90 1     1 1 688 my ($self, $stats, $sample_rate) = @_;
91 1         3 $self->update($stats, -1, $sample_rate);
92             }
93              
94             =head2 update(STATS, DELTA, SAMPLE_RATE)
95              
96             Update one of more stats counters by arbitrary amounts.
97              
98             =cut
99              
100             sub update {
101 5     5 1 1953 my ($self, $stats, $delta, $sample_rate) = @_;
102 5 100       12 $delta = 1 unless defined $delta;
103 5         6 my %data;
104 5 100       9 if (ref($stats) eq 'ARRAY') {
105 1         3 %data = map { $_ => "$delta|c" } @$stats;
  2         7  
106             }
107             else {
108 4         11 %data = ($stats => "$delta|c");
109             }
110 5         11 $self->send(\%data, $sample_rate);
111             }
112              
113             =head2 unique(STATS, ITEM, SAMPLE_RATE)
114              
115             Unique Set
116              
117             For example if you need count of unique ip adresses (per flush interval)
118             $stats->unique('ip.unique', $ip);
119              
120             =cut
121              
122             sub unique {
123 0     0 1   my ($self, $stats, $item, $sample_rate) = @_;
124 0           my %data = ($stats => "$item|s");
125 0           $self->send(\%data, $sample_rate);
126             }
127              
128             =head2 gauge(STATS, VALUE, SAMPLE_RATE)
129              
130             Gauge Set (Gauge, similar to kv but only the last value per key is retained)
131              
132             =cut
133              
134             sub gauge {
135 0     0 1   my ($self, $stats, $value, $sample_rate) = @_;
136 0           my %data = ($stats => "$value|g");
137 0           $self->send(\%data, $sample_rate);
138             }
139              
140             =head2 send(DATA, SAMPLE_RATE)
141              
142             Sending logging data; implicitly called by most of the other methods.
143              
144             =cut
145              
146             sub send {
147 0     0     my ($self, $data, $sample_rate) = @_;
148 0 0         $sample_rate = $self->{sample_rate} unless defined $sample_rate;
149              
150 0           my $sampled_data;
151 0 0 0       if (defined($sample_rate) and $sample_rate < 1) {
152 0           while (my ($stat, $value) = each %$data) {
153 0 0         $sampled_data->{$stat} = "$value|\@$sample_rate" if rand() <= $sample_rate;
154             }
155             }
156             else {
157 0           $sampled_data = $data;
158             }
159              
160 0 0         return '0 but true' unless keys %$sampled_data;
161              
162             #failures in any of this can be silently ignored
163 0           my $count = 0;
164 0           my $socket = $self->{socket};
165 0           while (my ($stat, $value) = each %$sampled_data) {
166              
167 0           my $key = $stat;
168 0 0         if ($$self{prefix}) {
169 0           $key = "$$self{ prefix }.$stat";
170             }
171              
172             #sanitize key (remove statsite separators)
173             #https://github.com/armon/statsite#protocol
174 0           $key =~ s/[:|]/_/g;
175              
176 0           _send_to_sock($socket, "$key:$value\n");
177 0           ++$count;
178             }
179 0           return $count;
180             }
181              
182             sub _send_to_sock( $$ ) {
183 0     0     my ($sock, $msg) = @_;
184 0           CORE::send($sock, $msg, 0);
185             }
186              
187             =head1 LICENSE
188              
189             Copyright (C) Avast Software.
190              
191             This library is free software; you can redistribute it and/or modify
192             it under the same terms as Perl itself.
193              
194             =head1 AUTHOR
195              
196             Jan Seidl Eseidl@avast.comE
197              
198             =cut
199              
200             1;