File Coverage

lib/InfluxDB/LineProtocol.pm
Criterion Covered Total %
statement 184 189 97.3
branch 47 60 78.3
condition 10 12 83.3
subroutine 19 19 100.0
pod 2 8 25.0
total 262 288 90.9


line stmt bran cond sub pod time code
1             package InfluxDB::LineProtocol;
2 4     4   376125 use strict;
  4         39  
  4         119  
3 4     4   19 use warnings;
  4         4  
  4         178  
4              
5             # ABSTRACT: Write and read InfluxDB LineProtocol
6              
7             our $VERSION = '1.013'; # VERSION
8              
9 4     4   21 use Carp qw(croak);
  4         4  
  4         212  
10 4     4   678 use Time::HiRes qw(gettimeofday);
  4         1409  
  4         25  
11              
12             my %versions = (
13             'v0.9.2' => '_0_9_2',
14             );
15              
16             sub import {
17 10     10   3692 my $class = shift;
18 10         31 my $caller = caller();
19              
20 10         194 my @to_export;
21             my $version;
22 10         15 my $precision = 'ns';
23 10         21 foreach my $param (@_) {
24 20 100 100     86 if ($param eq 'data2line' || $param eq 'line2data') {
25 13         27 push(@to_export,$param);
26             }
27 20 100       53 if ($param =~ /^precision=(\w+)$/) {
28 6         14 $precision = $1;
29             }
30 20 50 66     53 if ($param =~ /^v[\d\.]+$/ && $versions{$param}) {
31 1         3 $version = $versions{$param};
32             }
33             }
34              
35 10         16 foreach my $function (@to_export) {
36 13         17 my $target = $function;
37 13 100       28 $function = '_'.$function.$version if $version;
38              
39             {
40 4     4   1399 no strict 'refs';
  4         8  
  4         339  
  13         15  
41 13         21 *{"$caller\::$target"} = \&$function;
  13         63  
42             }
43             }
44              
45             # set up ts_$precision
46             {
47 4     4   27 no strict 'refs';
  4         5  
  4         9904  
  10         16  
48 10         17 my $selected = 'ts_'.$precision;
49 10         15 *{"$caller\::get_ts"} = \&$selected;
  10         187  
50             }
51              
52             }
53              
54             sub _format_key {
55 93     93   118 my $k = shift;
56              
57 93         160 $k =~ s/([, ])/\\$1/g;
58              
59 93         158 return $k;
60             }
61              
62             sub _format_value {
63 53     53   64 my $k = shift;
64 53         62 my $v = shift;
65              
66 53 100       303 if ( $v =~ /^(-?\d+)(?:i?)$/ ) {
    100          
    100          
    100          
67 29         88 $v = $1 . 'i';
68             }
69             elsif ( $v =~ /^[Ff](?:ALSE|alse)?$/ ) {
70 3         4 $v = 'FALSE';
71             }
72             elsif ( $v =~ /^[Tt](?:RUE|rue)?$/ ) {
73 2         4 $v = 'TRUE';
74             }
75             elsif ( $v =~ /^-?\d+(?:\.\d+)?(?:e(?:-|\+)?\d+)?$/ ) {
76             # pass it on, no mod
77             }
78             else {
79             # string actually, but this should be quoted differently?
80 13         47 $v =~ s/(["\\])/\\$1/g;
81 13         27 $v = '"' . $v . '"';
82             }
83              
84 53         91 return $v;
85             }
86              
87             sub data2line {
88 46     46 1 124311 my ( $measurement, $values, $tags, $timestamp ) = @_;
89 46         128 my $caller = caller();
90              
91 46 50       851 if ( @_ == 1 ) {
92             # no $fields, so assume we already got a line
93 0         0 return $measurement;
94             }
95              
96 46         66 my $key = $measurement;
97 46         157 $key =~ s/([, ])/\\$1/g;
98              
99             # $tags has to be a hashref, if it's not, we don't have tags, so it's the timestamp
100 46 100       87 if ( defined $tags ) {
101 13 100       40 if ( ref($tags) eq 'HASH' ) {
    50          
102 10         13 my @tags;
103 10         42 foreach my $k ( sort keys %$tags )
104             { # Influx wants the tags presorted
105             # TODO check if sorting algorithm matches
106             # http://golang.org/pkg/bytes/#Compare
107 15         21 my $v = $tags->{$k};
108 15 50       28 next unless defined $v;
109 15         32 $k =~ s/([, ])/\\$1/g;
110 15         51 $v =~ s/([, ])/\\$1/g;
111 15         39 push( @tags, $k . '=' . $v );
112             }
113 10 50       46 $key .= join( ',', '', @tags ) if @tags;
114             }
115             elsif ( !ref($tags) ) {
116 3         5 $timestamp = $tags;
117             }
118             }
119              
120 46   66     166 $timestamp ||= $caller->get_ts();
121 46 50       488 croak("$timestamp does not look like an epoch timestamp")
122             unless $timestamp =~ /^\d+$/;
123              
124             # If values is not a hashref, convert it into one
125 46 100       139 $values = { value => $values } if (not ref($values));
126              
127 46         60 my @fields;
128 46         143 foreach my $k ( sort keys %$values ) {
129 53         89 my $v = $values->{$k};
130              
131 53         85 my $esc_k = _format_key($k);
132 53         87 my $esc_v = _format_value($k, $v);
133              
134 53         158 push( @fields, $esc_k . '=' . $esc_v );
135             }
136 46         102 my $fields = join( ',', @fields );
137              
138 46         298 return sprintf( "%s %s %s", $key, $fields, $timestamp );
139             }
140              
141             sub ts_h {
142 2     2 0 4 my $now = time();
143 2         10 return int $now / 3600;
144             }
145              
146             sub ts_m {
147 2     2 0 4 my $now = time();
148 2         11 return int $now / 60;
149             }
150              
151             sub ts_s {
152 2     2 0 8 return scalar time();
153             }
154              
155             sub ts_ms {
156 2     2 0 579 my ($s,$us) = gettimeofday();
157 2         26 return sprintf("%s%03d", $s,substr($us,0,3));
158             }
159              
160             sub ts_us {
161 2     2 0 854 return sprintf("%s%06d", gettimeofday());
162             }
163              
164             sub ts_ns {
165 36     36 0 170 return sprintf("%s%06d000", gettimeofday());
166             }
167              
168             sub line2data {
169 39     39 1 66 my $line = shift;
170 39         62 chomp($line);
171              
172 39         102 $line =~ s/\\ /ESCAPEDSPACE/g;
173 39         62 $line =~ s/\\,/ESCAPEDCOMMA/g;
174 39         71 $line =~ s/\\"/ESCAPEDDBLQUOTE/g;
175 39         61 $line =~ s/\\\\/ESCAPEDBACKSLASH/g;
176              
177 39         200 $line=~/^(.*?) (.*) (.*)$/;
178 39         151 my ($key, $fields, $timestamp) = ( $1, $2, $3);
179              
180 39         110 my ( $measurement, @taglist ) = split( /,/, $key );
181 39         65 $measurement =~ s/ESCAPEDSPACE/ /g;
182 39         49 $measurement =~ s/ESCAPEDCOMMA/,/g;
183              
184 39         43 my $tags;
185 39         63 foreach my $tagset (@taglist) {
186 15         23 $tagset =~ s/ESCAPEDSPACE/ /g;
187 15         21 $tagset =~ s/ESCAPEDCOMMA/,/g;
188 15         34 my ( $k, $v ) = split( /=/, $tagset );
189 15         40 $tags->{$k} = $v;
190             }
191              
192 39         53 my $values;
193             my @strings;
194 39 100       99 if ($fields =~ /"/) {
195 11         13 my $cnt=0;
196 11         49 $fields=~s/"(.*?)"/push(@strings, $1); 'ESCAPEDSTRING_'.$cnt++;/ge;
  13         29  
  13         45  
197             }
198 39         83 foreach my $valset ( split( /,/, $fields ) ) {
199 46         63 $valset =~ s/ESCAPEDSPACE/ /g;
200 46         52 $valset =~ s/ESCAPEDCOMMA/,/g;
201 46         92 my ( $k, $v ) = split( /=/, $valset );
202 46         94 $v =~ s/ESCAPEDSTRING_(\d+)/$strings[$1]/ge;
  13         42  
203 46         72 $v =~ s/ESCAPEDDBLQUOTE/"/g;
204 46         59 $v =~ s/ESCAPEDBACKSLASH/\\/g;
205 46         125 $v =~ s/^(-?\d+)i$/$1/;
206 46         54 $k =~ s/ESCAPEDBACKSLASH/\\\\/g;
207 46         126 $values->{$k} = $v;
208             }
209              
210 39         152 return ( $measurement, $values, $tags, $timestamp );
211             }
212              
213             sub _data2line_0_9_2 {
214 34     34   108896 my ( $measurement, $values, $tags, $timestamp ) = @_;
215              
216 34 50       100 if ( @_ == 1 ) {
217             # no $fields, so assume we already got a line
218 0         0 return $measurement;
219             }
220              
221 34         53 my $key = $measurement;
222 34         126 $key =~ s/([, ])/\\$1/g;
223              
224             # $tags has to be a hashref, if it's not, we don't have tags, so it's the timestamp
225 34 100       75 if ( defined $tags ) {
226 12 100       47 if ( ref($tags) eq 'HASH' ) {
    50          
227 9         12 my @tags;
228 9         38 foreach my $k ( sort keys %$tags )
229             { # Influx wants the tags presorted
230             # TODO check if sorting algorithm matches
231             # http://golang.org/pkg/bytes/#Compare
232 13         24 my $v = $tags->{$k};
233 13 50       27 next unless defined $v;
234 13         37 $k =~ s/([, ])/\\$1/g;
235 13         30 $v =~ s/([, ])/\\$1/g;
236 13         37 push( @tags, $k . '=' . $v );
237             }
238 9 50       45 $key .= join( ',', '', @tags ) if @tags;
239             }
240             elsif ( !ref($tags) ) {
241 3         6 $timestamp = $tags;
242             }
243             }
244              
245 34 100       63 if ($timestamp) {
246 6 50       34 croak("$timestamp does not look like an epoch timestamp")
247             unless $timestamp =~ /^\d+$/;
248 6 50       18 if ( length($timestamp) < 19 ) {
249 0         0 my $missing = 19 - length($timestamp);
250 0         0 my $zeros = 0 x $missing;
251 0         0 $timestamp .= $zeros;
252             }
253             }
254             else {
255 28         67 $timestamp = join( '', gettimeofday(), '000' );
256 28 50       166 $timestamp .= '0' if length($timestamp) < 19;
257             }
258              
259             # If values is not a hashref, convert it into one
260 34 100       107 $values = { value => $values } if (not ref($values));
261              
262 34         53 my @fields;
263 34         114 foreach my $k ( sort keys %$values ) {
264 40         68 my $v = $values->{$k};
265 40         71 my $esc_k = _format_key($k);
266              
267 40 100 100     294 if (
268             # positive & negativ ints, exponentials, use Regexp::Common?
269             $v !~ /^-?\d+(?:\.\d+)?(?:e-?\d+)?$/
270             &&
271             # perl 5.12 Regexp::Assemble->new->add(qw(t T true TRUE f F false FALSE))->re;
272             $v !~ /^(?:F(?:ALSE)?|f(?:alse)?|T(?:RUE)?|t(?:rue)?)$/
273             )
274             {
275 13         27 $v =~ s/"/\\"/g;
276 13         30 $v = '"' . $v . '"';
277             }
278 40         117 push( @fields, $esc_k . '=' . $v );
279             }
280 34         88 my $fields = join( ',', @fields );
281              
282 34         252 return sprintf( "%s %s %s", $key, $fields, $timestamp );
283             }
284              
285             sub _line2data_0_9_2 {
286 34     34   60 my $line = shift;
287 34         53 chomp($line);
288              
289 34         95 $line =~ s/\\ /ESCAPEDSPACE/g;
290 34         60 $line =~ s/\\,/ESCAPEDCOMMA/g;
291 34         62 $line =~ s/\\"/ESCAPEDDBLQUOTE/g;
292              
293 34         196 $line=~/^(.*?) (.*) (.*)$/;
294 34         138 my ($key, $fields, $timestamp) = ( $1, $2, $3);
295              
296 34         102 my ( $measurement, @taglist ) = split( /,/, $key );
297 34         60 $measurement =~ s/ESCAPEDSPACE/ /g;
298 34         46 $measurement =~ s/ESCAPEDCOMMA/,/g;
299              
300 34         46 my $tags;
301 34         59 foreach my $tagset (@taglist) {
302 13         24 $tagset =~ s/ESCAPEDSPACE/ /g;
303 13         22 $tagset =~ s/ESCAPEDCOMMA/,/g;
304 13         33 my ( $k, $v ) = split( /=/, $tagset );
305 13         43 $tags->{$k} = $v;
306             }
307              
308 34         49 my $values;
309             my @strings;
310 34 100       94 if ($fields =~ /"/) {
311 11         12 my $cnt=0;
312 11         56 $fields=~s/"(.*?)"/push(@strings, $1); 'ESCAPEDSTRING_'.$cnt++;/ge;
  13         33  
  13         44  
313             }
314 34         75 foreach my $valset ( split( /,/, $fields ) ) {
315 40         56 $valset =~ s/ESCAPEDSPACE/ /g;
316 40         49 $valset =~ s/ESCAPEDCOMMA/,/g;
317 40         86 my ( $k, $v ) = split( /=/, $valset );
318 40         85 $v =~ s/ESCAPEDSTRING_(\d+)/$strings[$1]/ge;
  13         39  
319 40         54 $v =~ s/ESCAPEDDBLQUOTE/"/g;
320 40         114 $values->{$k} = $v;
321             }
322              
323 34         127 return ( $measurement, $values, $tags, $timestamp );
324             }
325              
326             1;
327              
328             __END__