1 package Collectd::Unixsock;
3 use strict;
4 use warnings;
6 use Carp (qw(cluck confess));
7 use IO::Socket::UNIX;
8 use Regexp::Common (qw(number));
10 return (1);
12 sub _create_socket
13 {
14 my $path = shift;
15 my $sock = IO::Socket::UNIX->new (Type => SOCK_STREAM, Peer => $path);
16 if (!$sock)
17 {
18 cluck ("Cannot open UNIX-socket $path: $!");
19 return;
20 }
21 return ($sock);
22 } # _create_socket
24 sub _create_identifier
25 {
26 my $args = shift;
27 my $host;
28 my $plugin;
29 my $type;
31 if (!$args->{'host'} || !$args->{'plugin'} || !$args->{'type'})
32 {
33 cluck ("Need `host', `plugin' and `type'");
34 return;
35 }
37 $host = $args->{'host'};
38 $plugin = $args->{'plugin'};
39 $plugin .= '-' . $args->{'plugin_instance'} if ($args->{'plugin_instance'});
40 $type = $args->{'type'};
41 $type .= '-' . $args->{'type_instance'} if ($args->{'type_instance'});
43 return ("$host/$plugin/$type");
44 } # _create_identifier
46 sub new
47 {
48 my $pkg = shift;
49 my $path = @_ ? shift : '/var/run/collectd-unixsock';
50 my $sock = _create_socket ($path) or return;
51 my $obj = bless (
52 {
53 path => $path,
54 sock => $sock,
55 error => 'No error'
56 }, $pkg);
57 return ($obj);
58 } # new
60 sub getval
61 {
62 my $obj = shift;
63 my %args = @_;
65 my $status;
66 my $fh = $obj->{'sock'} or confess;
67 my $msg;
68 my $identifier;
70 my $ret = {};
72 $identifier = _create_identifier (\%args) or return;
74 $msg = "GETVAL $identifier\n";
75 send ($fh, $msg, 0) or confess ("send: $!");
77 $msg = undef;
78 recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
80 ($status, $msg) = split (' ', $msg, 2);
81 if ($status <= 0)
82 {
83 $obj->{'error'} = $msg;
84 return;
85 }
87 for (split (' ', $msg))
88 {
89 my $entry = $_;
90 if ($entry =~ m/^(\w+)=($RE{num}{real})$/)
91 {
92 $ret->{$1} = 0.0 + $2;
93 }
94 }
96 return ($ret);
97 } # getval
99 sub putval
100 {
101 my $obj = shift;
102 my %args = @_;
104 my $status;
105 my $fh = $obj->{'sock'} or confess;
106 my $msg;
107 my $identifier;
108 my $values;
110 $identifier = _create_identifier (\%args) or return;
111 if (!$args{'values'})
112 {
113 cluck ("Need argument `values'");
114 return;
115 }
117 if (!ref ($args{'values'}))
118 {
119 $values = $args{'values'};
120 }
121 else
122 {
123 my $time = $args{'time'} ? $args{'time'} : time ();
124 $values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}}));
125 }
127 $msg = "PUTVAL $identifier $values\n";
128 send ($fh, $msg, 0) or confess ("send: $!");
129 $msg = undef;
130 recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
132 ($status, $msg) = split (' ', $msg, 2);
133 return (1) if ($status == 0);
135 $obj->{'error'} = $msg;
136 return;
137 } # putval
139 sub destroy
140 {
141 my $obj = shift;
142 if ($obj->{'sock'})
143 {
144 close ($obj->{'sock'});
145 delete ($obj->{'sock'});
146 }
147 }
149 sub DESTROY
150 {
151 my $obj = shift;
152 $obj->destroy ();
153 }