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   390537 use strict;
  4         37  
  4         120  
3 4     4   21 use warnings;
  4         7  
  4         201  
4              
5             # ABSTRACT: Write and read InfluxDB LineProtocol
6              
7             our $VERSION = '1.014'; # VERSION
8              
9 4     4   23 use Carp qw(croak);
  4         7  
  4         288  
10 4     4   598 use Time::HiRes qw(gettimeofday);
  4         1499  
  4         34  
11              
12             my %versions = (
13             'v0.9.2' => '_0_9_2',
14             );
15              
16             sub import {
17 10     10   3694 my $class = shift;
18 10         33 my $caller = caller();
19              
20 10         197 my @to_export;
21             my $version;
22 10         16 my $precision = 'ns';
23 10         18 foreach my $param (@_) {
24 20 100 100     82 if ($param eq 'data2line' || $param eq 'line2data') {
25 13         21 push(@to_export,$param);
26             }
27 20 100       58 if ($param =~ /^precision=(\w+)$/) {
28 6         17 $precision = $1;
29             }
30 20 50 66     51 if ($param =~ /^v[\d\.]+$/ && $versions{$param}) {
31 1         3 $version = $versions{$param};
32             }
33             }
34              
35 10         19 foreach my $function (@to_export) {
36 13         20 my $target = $function;
37 13 100       26 $function = '_'.$function.$version if $version;
38              
39             {
40 4     4   1448 no strict 'refs';
  4         20  
  4         356  
  13         16  
41 13         25 *{"$caller\::$target"} = \&$function;
  13         78  
42             }
43             }
44              
45             # set up ts_$precision
46             {
47 4     4   30 no strict 'refs';
  4         6  
  4         10218  
  10         16  
48 10         15 my $selected = 'ts_'.$precision;
49 10         20 *{"$caller\::get_ts"} = \&$selected;
  10         185  
50             }
51              
52             }
53              
54             sub _format_key {
55 93     93   146 my $k = shift;
56              
57 93         157 $k =~ s/([, ])/\\$1/g;
58              
59 93         154 return $k;
60             }
61              
62             sub _format_value {
63 53     53   60 my $k = shift;
64 53         66 my $v = shift;
65              
66 53 100       351 if ( $v =~ /^(-?\d+)(?:i?)$/ ) {
    100          
    100          
    100          
67 29         84 $v = $1 . 'i';
68             }
69             elsif ( $v =~ /^[Ff](?:ALSE|alse)?$/ ) {
70 3         36 $v = 'FALSE';
71             }
72             elsif ( $v =~ /^[Tt](?:RUE|rue)?$/ ) {
73 2         12 $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         53 $v =~ s/(["\\])/\\$1/g;
81 13         32 $v = '"' . $v . '"';
82             }
83              
84 53         107 return $v;
85             }
86              
87             sub data2line {
88 46     46 1 127169 my ( $measurement, $values, $tags, $timestamp ) = @_;
89 46         148 my $caller = caller();
90              
91 46 50       857 if ( @_ == 1 ) {
92             # no $fields, so assume we already got a line
93 0         0 return $measurement;
94             }
95              
96 46         75 my $key = $measurement;
97 46         160 $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       107 if ( defined $tags ) {
101 13 100       45 if ( ref($tags) eq 'HASH' ) {
    50          
102 10         19 my @tags;
103 10         41 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         33 my $v = $tags->{$k};
108 15 50       31 next unless defined $v;
109 15         45 $k =~ s/([, ])/\\$1/g;
110 15         42 $v =~ s/([, ])/\\$1/g;
111 15         46 push( @tags, $k . '=' . $v );
112             }
113 10 50       44 $key .= join( ',', '', @tags ) if @tags;
114             }
115             elsif ( !ref($tags) ) {
116 3         6 $timestamp = $tags;
117             }
118             }
119              
120 46   66     189 $timestamp ||= $caller->get_ts();
121 46 50       551 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       168 $values = { value => $values } if (not ref($values));
126              
127 46         58 my @fields;
128 46         169 foreach my $k ( sort keys %$values ) {
129 53         104 my $v = $values->{$k};
130              
131 53         83 my $esc_k = _format_key($k);
132 53         103 my $esc_v = _format_value($k, $v);
133              
134 53         158 push( @fields, $esc_k . '=' . $esc_v );
135             }
136 46         103 my $fields = join( ',', @fields );
137              
138 46         355 return sprintf( "%s %s %s", $key, $fields, $timestamp );
139             }
140              
141             sub ts_h {
142 2     2 0 5 my $now = time();
143 2         8 return int $now / 3600;
144             }
145              
146             sub ts_m {
147 2     2 0 5 my $now = time();
148 2         10 return int $now / 60;
149             }
150              
151             sub ts_s {
152 2     2 0 7 return scalar time();
153             }
154              
155             sub ts_ms {
156 2     2 0 528 my ($s,$us) = gettimeofday();
157 2         27 return sprintf("%s%03d", $s,substr($us,0,3));
158             }
159              
160             sub ts_us {
161 2     2 0 829 return sprintf("%s%06d", gettimeofday());
162             }
163              
164             sub ts_ns {
165 36     36 0 198 return sprintf("%s%06d000", gettimeofday());
166             }
167              
168             sub line2data {
169 39     39 1 74 my $line = shift;
170 39         72 chomp($line);
171              
172 39         105 $line =~ s/\\ /ESCAPEDSPACE/g;
173 39         67 $line =~ s/\\,/ESCAPEDCOMMA/g;
174 39         79 $line =~ s/\\"/ESCAPEDDBLQUOTE/g;
175 39         72 $line =~ s/\\\\/ESCAPEDBACKSLASH/g;
176              
177 39         218 $line=~/^(.*?) (.*) (.*)$/;
178 39         168 my ($key, $fields, $timestamp) = ( $1, $2, $3);
179              
180 39         122 my ( $measurement, @taglist ) = split( /,/, $key );
181 39         68 $measurement =~ s/ESCAPEDSPACE/ /g;
182 39         55 $measurement =~ s/ESCAPEDCOMMA/,/g;
183              
184 39         46 my $tags;
185 39         66 foreach my $tagset (@taglist) {
186 15         28 $tagset =~ s/ESCAPEDSPACE/ /g;
187 15         25 $tagset =~ s/ESCAPEDCOMMA/,/g;
188 15         37 my ( $k, $v ) = split( /=/, $tagset );
189 15         45 $tags->{$k} = $v;
190             }
191              
192 39         63 my $values;
193             my @strings;
194 39 100       110 if ($fields =~ /"/) {
195 11         20 my $cnt=0;
196 11         56 $fields=~s/"(.*?)"/push(@strings, $1); 'ESCAPEDSTRING_'.$cnt++;/ge;
  13         38  
  13         49  
197             }
198 39         97 foreach my $valset ( split( /,/, $fields ) ) {
199 46         71 $valset =~ s/ESCAPEDSPACE/ /g;
200 46         59 $valset =~ s/ESCAPEDCOMMA/,/g;
201 46         107 my ( $k, $v ) = split( /=/, $valset );
202 46         99 $v =~ s/ESCAPEDSTRING_(\d+)/$strings[$1]/ge;
  13         44  
203 46         70 $v =~ s/ESCAPEDDBLQUOTE/"/g;
204 46         58 $v =~ s/ESCAPEDBACKSLASH/\\/g;
205 46         124 $v =~ s/^(-?\d+)i$/$1/;
206 46         60 $k =~ s/ESCAPEDBACKSLASH/\\\\/g;
207 46         129 $values->{$k} = $v;
208             }
209              
210 39         163 return ( $measurement, $values, $tags, $timestamp );
211             }
212              
213             sub _data2line_0_9_2 {
214 34     34   108867 my ( $measurement, $values, $tags, $timestamp ) = @_;
215              
216 34 50       89 if ( @_ == 1 ) {
217             # no $fields, so assume we already got a line
218 0         0 return $measurement;
219             }
220              
221 34         51 my $key = $measurement;
222 34         125 $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       63 if ( defined $tags ) {
226 12 100       41 if ( ref($tags) eq 'HASH' ) {
    50          
227 9         14 my @tags;
228 9         37 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         25 my $v = $tags->{$k};
233 13 50       26 next unless defined $v;
234 13         33 $k =~ s/([, ])/\\$1/g;
235 13         27 $v =~ s/([, ])/\\$1/g;
236 13         40 push( @tags, $k . '=' . $v );
237             }
238 9 50       40 $key .= join( ',', '', @tags ) if @tags;
239             }
240             elsif ( !ref($tags) ) {
241 3         6 $timestamp = $tags;
242             }
243             }
244              
245 34 100       65 if ($timestamp) {
246 6 50       33 croak("$timestamp does not look like an epoch timestamp")
247             unless $timestamp =~ /^\d+$/;
248 6 50       15 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         72 $timestamp = join( '', gettimeofday(), '000' );
256 28 50       156 $timestamp .= '0' if length($timestamp) < 19;
257             }
258              
259             # If values is not a hashref, convert it into one
260 34 100       86 $values = { value => $values } if (not ref($values));
261              
262 34         45 my @fields;
263 34         122 foreach my $k ( sort keys %$values ) {
264 40         60 my $v = $values->{$k};
265 40         66 my $esc_k = _format_key($k);
266              
267 40 100 100     280 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         32 $v =~ s/"/\\"/g;
276 13         27 $v = '"' . $v . '"';
277             }
278 40         124 push( @fields, $esc_k . '=' . $v );
279             }
280 34         73 my $fields = join( ',', @fields );
281              
282 34         241 return sprintf( "%s %s %s", $key, $fields, $timestamp );
283             }
284              
285             sub _line2data_0_9_2 {
286 34     34   65 my $line = shift;
287 34         57 chomp($line);
288              
289 34         92 $line =~ s/\\ /ESCAPEDSPACE/g;
290 34         59 $line =~ s/\\,/ESCAPEDCOMMA/g;
291 34         56 $line =~ s/\\"/ESCAPEDDBLQUOTE/g;
292              
293 34         175 $line=~/^(.*?) (.*) (.*)$/;
294 34         131 my ($key, $fields, $timestamp) = ( $1, $2, $3);
295              
296 34         99 my ( $measurement, @taglist ) = split( /,/, $key );
297 34         57 $measurement =~ s/ESCAPEDSPACE/ /g;
298 34         47 $measurement =~ s/ESCAPEDCOMMA/,/g;
299              
300 34         37 my $tags;
301 34         54 foreach my $tagset (@taglist) {
302 13         22 $tagset =~ s/ESCAPEDSPACE/ /g;
303 13         20 $tagset =~ s/ESCAPEDCOMMA/,/g;
304 13         28 my ( $k, $v ) = split( /=/, $tagset );
305 13         39 $tags->{$k} = $v;
306             }
307              
308 34         49 my $values;
309             my @strings;
310 34 100       92 if ($fields =~ /"/) {
311 11         16 my $cnt=0;
312 11         50 $fields=~s/"(.*?)"/push(@strings, $1); 'ESCAPEDSTRING_'.$cnt++;/ge;
  13         32  
  13         48  
313             }
314 34         74 foreach my $valset ( split( /,/, $fields ) ) {
315 40         57 $valset =~ s/ESCAPEDSPACE/ /g;
316 40         47 $valset =~ s/ESCAPEDCOMMA/,/g;
317 40         83 my ( $k, $v ) = split( /=/, $valset );
318 40         82 $v =~ s/ESCAPEDSTRING_(\d+)/$strings[$1]/ge;
  13         43  
319 40         86 $v =~ s/ESCAPEDDBLQUOTE/"/g;
320 40         108 $values->{$k} = $v;
321             }
322              
323 34         124 return ( $measurement, $values, $tags, $timestamp );
324             }
325              
326             1;
327              
328             __END__