File Coverage

blib/lib/ETL/Yertl/Adapter/influxdb.pm
Criterion Covered Total %
statement 92 103 89.3
branch 17 26 65.3
condition 9 18 50.0
subroutine 15 15 100.0
pod 3 4 75.0
total 136 166 81.9


line stmt bran cond sub pod time code
1             package ETL::Yertl::Adapter::influxdb;
2             our $VERSION = '0.036';
3             # ABSTRACT: Adapter to read/write from InfluxDB time series database
4              
5             #pod =head1 SYNOPSIS
6             #pod
7             #pod my $db = ETL::Yertl::Adapter::influxdb->new( 'influxdb://localhost:8086' );
8             #pod my @points = $db->read_ts( { metric => 'db.cpu_load.1m' } );
9             #pod $db->write_ts( { metric => 'db.cpu_load.1m', value => 1.23 } );
10             #pod
11             #pod =head1 DESCRIPTION
12             #pod
13             #pod This class allows Yertl to read and write time series from L
14             #pod time series database|https://www.influxdata.com>.
15             #pod
16             #pod This adapter is used by the L command.
17             #pod
18             #pod =head2 Metric Name Format
19             #pod
20             #pod InfluxDB has databases, metrics, and fields. In Yertl, the time series
21             #pod is identified by joining the database, metric, and field with periods (C<.>).
22             #pod The field is optional, and defaults to C.
23             #pod
24             #pod # Database "foo", metric "bar", field "baz"
25             #pod yts influxdb://localhost foo.bar.baz
26             #pod
27             #pod # Database "foo", metric "bar", field "value"
28             #pod yts influxdb://localhost foo.bar
29             #pod
30             #pod =head1 SEE ALSO
31             #pod
32             #pod L, L,
33             #pod L,
34             #pod L,
35             #pod L
36             #pod
37             #pod =cut
38              
39 1     1   197953 use ETL::Yertl;
  1         2  
  1         9  
40 1     1   348 use Net::Async::HTTP;
  1         37648  
  1         35  
41 1     1   8 use URI;
  1         1  
  1         21  
42 1     1   300 use JSON::MaybeXS qw( decode_json );
  1         3822  
  1         55  
43 1     1   7 use List::Util qw( first );
  1         2  
  1         88  
44 1     1   6 use IO::Async::Loop;
  1         2  
  1         22  
45 1     1   288 use Time::Piece ();
  1         5957  
  1         27  
46 1     1   6 use Scalar::Util qw( looks_like_number );
  1         2  
  1         1026  
47              
48             #pod =method new
49             #pod
50             #pod my $db = ETL::Yertl::Adapter::influxdb->new( 'influxdb://localhost' );
51             #pod my $db = ETL::Yertl::Adapter::influxdb->new( 'influxdb://localhost:8086' );
52             #pod
53             #pod Construct a new InfluxDB adapter for the database on the given host and port.
54             #pod Port is optional and defaults to C<8086>.
55             #pod
56             #pod =cut
57              
58             sub new {
59 5     5 1 28001 my $class = shift;
60              
61 5         9 my %args;
62 5 100       15 if ( @_ == 1 ) {
63 3 100       20 if ( $_[0] =~ m{://([^:]+)(?::([^/]+))?} ) {
64 2         10 ( $args{host}, $args{port} ) = ( $1, $2 );
65             }
66             }
67             else {
68 2         7 %args = @_;
69             }
70              
71 5 100       21 die "Host is required" unless $args{host};
72              
73 4   100     18 $args{port} ||= 8086;
74              
75 4         12 return bless \%args, $class;
76             }
77              
78             sub _loop {
79 2     2   6 my ( $self ) = @_;
80 2   33     18 return $self->{_loop} ||= IO::Async::Loop->new;
81             }
82              
83             sub client {
84 2     2 0 5 my ( $self ) = @_;
85 2   33     9 return $self->{http_client} ||= do {
86 2         20 my $http = Net::Async::HTTP->new;
87 2         169 $self->_loop->add( $http );
88 2         140 $http;
89             };
90             }
91              
92             #pod =method read_ts
93             #pod
94             #pod my @points = $db->read_ts( $query );
95             #pod
96             #pod Read a time series from the database. C<$query> is a hash reference
97             #pod with the following keys:
98             #pod
99             #pod =over
100             #pod
101             #pod =item metric
102             #pod
103             #pod The time series to read. For InfluxDB, this is the database, metric, and
104             #pod field separated by dots (C<.>). Field defaults to C.
105             #pod
106             #pod =item start
107             #pod
108             #pod An ISO8601 date/time for the start of the series points to return,
109             #pod inclusive.
110             #pod
111             #pod =item end
112             #pod
113             #pod An ISO8601 date/time for the end of the series points to return,
114             #pod inclusive.
115             #pod
116             #pod =item tags
117             #pod
118             #pod An optional hashref of tags. If specified, only points matching all of
119             #pod these tags will be returned.
120             #pod
121             #pod =back
122             #pod
123             #pod =cut
124              
125             sub read_ts {
126 1     1 1 564 my ( $self, $query ) = @_;
127 1         3 my $metric = $query->{ metric };
128 1         4 ( my $db, $metric, my $field ) = split /\./, $metric;
129 1   50     4 $field ||= "value";
130              
131 1         5 my $q = sprintf 'SELECT "%s" FROM "%s"', $field, $metric;
132 1         2 my @where;
133 1         2 my $tags = $query->{ tags };
134 1 50 33     5 if ( $tags && keys %$tags ) {
135 0         0 push @where, map { sprintf q{"%s"='%s'}, $_, $tags->{ $_ } } keys %$tags;
  0         0  
136             }
137 1 50       13 if ( my $start = $query->{start} ) {
138 0         0 push @where, qq{time >= '$start'};
139             }
140 1 50       3 if ( my $end = $query->{end} ) {
141 0         0 push @where, qq{time <= '$end'};
142             }
143 1 50       3 if ( @where ) {
144 0         0 $q .= ' WHERE ' . join " AND ", @where;
145             }
146              
147 1         11 my $url = URI->new( sprintf 'http://%s:%s/query', $self->{host}, $self->{port} );
148 1         5037 $url->query_form( db => $db, q => $q );
149              
150             #; say "Fetching $url";
151 1         172 my $res = $self->client->GET( $url )->get;
152              
153             #; say $res->decoded_content;
154 1 50       209 if ( $res->is_error ) {
155 0         0 die sprintf "Error fetching metric '%s': " . $res->decoded_content . "\n", $metric;
156             }
157              
158 1         14 my $result = decode_json( $res->decoded_content );
159 1         1518 my @points;
160 1         2 for my $series ( map @{ $_->{series} }, @{ $result->{results} } ) {
  1         5  
  1         3  
161 1     1   5 my $time_i = first { $series->{columns}[$_] eq 'time' } 0..$#{ $series->{columns} };
  1         3  
  1         7  
162 1     2   5 my $value_i = first { $series->{columns}[$_] eq $field } 0..$#{ $series->{columns} };
  2         5  
  1         3  
163              
164             push @points, map {
165             +{
166 2 50       12 metric => join( ".", $db, $series->{name}, ( $field ne 'value' ? ( $field ) : () ) ),
167             timestamp => $_->[ $time_i ],
168             value => $_->[ $value_i ],
169             }
170 1         3 } @{ $series->{values} };
  1         2  
171             }
172              
173 1         11 return @points;
174             }
175              
176             #pod =method write_ts
177             #pod
178             #pod $db->write_ts( @points );
179             #pod
180             #pod Write time series points to the database. C<@points> is an array
181             #pod of hashrefs with the following keys:
182             #pod
183             #pod =over
184             #pod
185             #pod =item metric
186             #pod
187             #pod The metric to write. For InfluxDB, this is the database, metric,
188             #pod and field separated by dots (C<.>). Field defaults to C.
189             #pod
190             #pod =item timestamp
191             #pod
192             #pod An ISO8601 timestamp or UNIX epoch time. Optional. Defaults to the
193             #pod current time.
194             #pod
195             #pod =item value
196             #pod
197             #pod The metric value.
198             #pod
199             #pod =back
200             #pod
201             #pod =cut
202              
203             sub write_ts {
204 1     1 1 58 my ( $self, @points ) = @_;
205              
206 1         2 my %db_lines;
207 1         3 for my $point ( @points ) {
208 3         11 my ( $db, $metric, $field ) = split /\./, $point->{metric};
209 3         5 my $tags = '';
210 3 50       7 if ( $point->{tags} ) {
211 0         0 $tags = join ",", '', map { join "=", $_, $point->{tags}{$_} } keys %{ $point->{tags} };
  0         0  
  0         0  
212             }
213              
214 3         5 my $ts = '';
215 3 50 66     11 if ( my $epoch = $point->{timestamp} || time ) {
216 3 100       41 if ( !looks_like_number( $epoch ) ) {
217 1         6 $epoch =~ s/[.]\d+Z?$//; # We do not support nanoseconds
218 1         11 $epoch = Time::Piece->strptime( $epoch, '%Y-%m-%dT%H:%M:%S' )->epoch;
219             }
220 3         147 $ts = " " . ( $epoch * 10**9 );
221             }
222              
223 3         30 push @{ $db_lines{ $db } }, sprintf '%s%s %s=%s%s',
224             $metric, $tags, $field || "value",
225 3   50     3 $point->{value}, $ts;
226             }
227              
228 1         4 for my $db ( keys %db_lines ) {
229 1         3 my @lines = @{ $db_lines{ $db } };
  1         3  
230 1         4 my $body = join "\n", @lines;
231 1         7 my $url = URI->new( sprintf 'http://%s:%s/write?db=%s', $self->{host}, $self->{port}, $db );
232 1         75 my $res = $self->client->POST( $url, $body, content_type => 'text/plain' )->get;
233 1 50       165 if ( $res->is_error ) {
234 0         0 my $result = decode_json( $res->decoded_content );
235 0         0 die "Error writing metric '%s': $result->{error}\n";
236             }
237             }
238              
239 1         13 return;
240             }
241              
242             1;
243              
244             __END__