1 package Collectd::Unixsock;
3 =head1 NAME
5 Collectd::Unixsock - Abstraction layer for accessing the functionality by collectd's unixsock plugin.
7 =head1 SYNOPSIS
9 use Collectd::Unixsock ();
11 my $sock = Collectd::Unixsock->new ($path);
13 my $value = $sock->getval (%identifier);
14 $sock->putval (%identifier,
15 time => time (),
16 values => [123, 234, 345]);
18 $sock->destroy ();
20 =head1 DESCRIPTION
22 collectd's unixsock plugin allows external programs to access the values it has
23 collected or received and to submit own values. This Perl-module is simply a
24 little abstraction layer over this interface to make it even easier for
25 programmers to interact with the daemon.
27 =cut
29 use strict;
30 use warnings;
32 use Carp (qw(cluck confess));
33 use IO::Socket::UNIX;
34 use Regexp::Common (qw(number));
36 return (1);
38 sub _create_socket
39 {
40 my $path = shift;
41 my $sock = IO::Socket::UNIX->new (Type => SOCK_STREAM, Peer => $path);
42 if (!$sock)
43 {
44 cluck ("Cannot open UNIX-socket $path: $!");
45 return;
46 }
47 return ($sock);
48 } # _create_socket
50 =head1 VALUE IDENTIFIER
52 The values in the collectd are identified using an five-tupel (host, plugin,
53 plugin-instance, type, type-instance) where only plugin-instance and
54 type-instance may be NULL (or undefined). Many functions expect an
55 I<%identifier> hash that has at least the members B<host>, B<plugin>, and
56 B<type>, possibly completed by B<plugin_instance> and B<type_instance>.
58 Usually you can pass this hash as follows:
60 $obj->method (host => $host, plugin => $plugin, type => $type, %other_args);
62 =cut
64 sub _create_identifier
65 {
66 my $args = shift;
67 my $host;
68 my $plugin;
69 my $type;
71 if (!$args->{'host'} || !$args->{'plugin'} || !$args->{'type'})
72 {
73 cluck ("Need `host', `plugin' and `type'");
74 return;
75 }
77 $host = $args->{'host'};
78 $plugin = $args->{'plugin'};
79 $plugin .= '-' . $args->{'plugin_instance'} if (defined ($args->{'plugin_instance'}));
80 $type = $args->{'type'};
81 $type .= '-' . $args->{'type_instance'} if (defined ($args->{'type_instance'}));
83 return ("$host/$plugin/$type");
84 } # _create_identifier
86 sub _parse_identifier
87 {
88 my $string = shift;
89 my $host;
90 my $plugin;
91 my $plugin_instance;
92 my $type;
93 my $type_instance;
94 my $ident;
96 ($host, $plugin, $type) = split ('/', $string);
98 ($plugin, $plugin_instance) = split ('-', $plugin, 2);
99 ($type, $type_instance) = split ('-', $type, 2);
101 $ident =
102 {
103 host => $host,
104 plugin => $plugin,
105 type => $type
106 };
107 $ident->{'plugin_instance'} = $plugin_instance if (defined ($plugin_instance));
108 $ident->{'type_instance'} = $type_instance if (defined ($type_instance));
110 return ($ident);
111 } # _parse_identifier
113 =head1 PUBLIC METHODS
115 =over 4
117 =item I<$obj> = Collectd::Unixsock->B<new> ([I<$path>]);
119 Creates a new connection to the daemon. The optional I<$path> argument gives
120 the path to the UNIX socket of the C<unixsock plugin> and defaults to
121 F</var/run/collectd-unixsock>. Returns the newly created object on success and
122 false on error.
124 =cut
126 sub new
127 {
128 my $pkg = shift;
129 my $path = @_ ? shift : '/var/run/collectd-unixsock';
130 my $sock = _create_socket ($path) or return;
131 my $obj = bless (
132 {
133 path => $path,
134 sock => $sock,
135 error => 'No error'
136 }, $pkg);
137 return ($obj);
138 } # new
140 =item I<$res> = I<$obj>-E<gt>B<getval> (I<%identifier>);
142 Requests a value-list from the daemon. On success a hash-ref is returned with
143 the name of each data-source as the key and the according value as, well, the
144 value. On error false is returned.
146 =cut
148 sub getval
149 {
150 my $obj = shift;
151 my %args = @_;
153 my $status;
154 my $fh = $obj->{'sock'} or confess;
155 my $msg;
156 my $identifier;
158 my $ret = {};
160 $identifier = _create_identifier (\%args) or return;
162 $msg = "GETVAL $identifier\n";
163 #print "-> $msg";
164 send ($fh, $msg, 0) or confess ("send: $!");
166 $msg = undef;
167 recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
168 #print "<- $msg";
170 ($status, $msg) = split (' ', $msg, 2);
171 if ($status <= 0)
172 {
173 $obj->{'error'} = $msg;
174 return;
175 }
177 for (split (' ', $msg))
178 {
179 my $entry = $_;
180 if ($entry =~ m/^(\w+)=NaN$/)
181 {
182 $ret->{$1} = undef;
183 }
184 elsif ($entry =~ m/^(\w+)=($RE{num}{real})$/)
185 {
186 $ret->{$1} = 0.0 + $2;
187 }
188 }
190 return ($ret);
191 } # getval
193 =item I<$obj>-E<gt>B<putval> (I<%identifier>, B<time> => I<$time>, B<values> => [...]);
195 Submits a value-list to the daemon. If the B<time> argument is omitted
196 C<time()> is used. The requierd argument B<values> is a reference to an array
197 of values that is to be submitted. The number of values must match the number
198 of values expected for the given B<type> (see L<VALUE IDENTIFIER>), though this
199 is checked by the daemon, not the Perl module. Also, gauge data-sources
200 (e.E<nbsp>g. system-load) may be C<undef>. Returns true upon success and false
201 otherwise.
203 =cut
205 sub putval
206 {
207 my $obj = shift;
208 my %args = @_;
210 my $status;
211 my $fh = $obj->{'sock'} or confess;
212 my $msg;
213 my $identifier;
214 my $values;
216 $identifier = _create_identifier (\%args) or return;
217 if (!$args{'values'})
218 {
219 cluck ("Need argument `values'");
220 return;
221 }
223 if (!ref ($args{'values'}))
224 {
225 $values = $args{'values'};
226 }
227 else
228 {
229 my $time = $args{'time'} ? $args{'time'} : time ();
230 $values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}}));
231 }
233 $msg = "PUTVAL $identifier $values\n";
234 #print "-> $msg";
235 send ($fh, $msg, 0) or confess ("send: $!");
236 $msg = undef;
237 recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
238 #print "<- $msg";
240 ($status, $msg) = split (' ', $msg, 2);
241 return (1) if ($status == 0);
243 $obj->{'error'} = $msg;
244 return;
245 } # putval
247 =item I<$res> = I<$obj>-E<gt>B<listval> ()
249 Queries a list of values from the daemon. The list is returned as an array of
250 hash references, where each hash reference is a valid identifier. The C<time>
251 member of each hash holds the epoch value of the last update of that value.
253 =cut
255 sub listval
256 {
257 my $obj = shift;
258 my $msg;
259 my @ret = ();
260 my $status;
261 my $fh = $obj->{'sock'} or confess;
263 $msg = "LISTVAL\n";
264 send ($fh, $msg, 0) or confess ("send: $!");
266 $msg = <$fh>;
267 ($status, $msg) = split (' ', $msg, 2);
268 if ($status < 0)
269 {
270 $obj->{'error'} = $msg;
271 return;
272 }
274 for (my $i = 0; $i < $status; $i++)
275 {
276 my $time;
277 my $ident;
279 $msg = <$fh>;
280 chomp ($msg);
282 ($time, $ident) = split (' ', $msg, 2);
284 $ident = _parse_identifier ($ident);
285 $ident->{'time'} = int ($time);
287 push (@ret, $ident);
288 } # for (i = 0 .. $status)
290 return (@ret);
291 } # listval
293 =item I<$obj>-E<gt>destroy ();
295 Closes the socket before the object is destroyed. This function is also
296 automatically called then the object goes out of scope.
298 =back
300 =cut
302 sub destroy
303 {
304 my $obj = shift;
305 if ($obj->{'sock'})
306 {
307 close ($obj->{'sock'});
308 delete ($obj->{'sock'});
309 }
310 }
312 sub DESTROY
313 {
314 my $obj = shift;
315 $obj->destroy ();
316 }
318 =head1 AUTHOR
320 Florian octo Forster E<lt>octo@verplant.orgE<gt>
322 =cut